source: LMDZ6/branches/LMDZ_ECRad/libf/dyn3d/qminimum.F @ 5227

Last change on this file since 5227 was 4143, checked in by dcugnet, 3 years ago
  • Some variables are renamed or replaced by direct equivalents:
    • iso_indnum -> tracers(:)%iso_iName
    • niso_possibles -> niso
    • iqiso -> iqIsoPha ; index_trac -> itZonIso
    • ok_iso_verif -> isoCheck
    • ntraceurs_zone -> nzone ; ntraciso -> ntiso
    • qperemin -> min_qparent ; masseqmin -> min_qmass ; ratiomin -> min_ratio
  • Some renamed variables are only aliased with the older name (using USE <module>, ONLY: <oldName> => <newName>) in routines where they are repeated many times.
  • Few hard-coded indexes are now computed (examples: ilic, iso, ivap, irneb, iq_vap, iq_liq, iso_H2O, iso_HDO, iso_HTO, iso_O17, iso_O18).
  • The IF(isoCheck) test is now embedded in the check_isotopes_seq and check_isotopes_loc routines (lighter calling).
  • 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.4 KB
Line 
1!
2! $Header$
3!
4      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
10c
11c  -- Objet : Traiter les valeurs trop petites (meme negatives)
12c             pour l'eau vapeur et l'eau liquide
13c
14      include "dimensions.h"
15      include "paramet.h"
16c
17      INTEGER nqtot
18      REAL q(ip1jmp1,llm,nqtot), deltap(ip1jmp1,llm)
19c
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
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
45
46      IF(first) THEN
47         iq_vap = strIdx(tracers(:)%name, addPhase('H2O', 'g'))
48         iq_liq = strIdx(tracers(:)%name, addPhase('H2O', 'l'))
49         first = .FALSE.
50      END IF
51c
52c Quand l'eau liquide est trop petite (ou negative), on prend
53c l'eau vapeur de la meme couche et la convertit en eau liquide
54c (sans changer la temperature !)
55c
56
57      call check_isotopes_seq(q,ip1jmp1,'qminimum 52')   
58
59      zx_defau_diag(:,:,:)=0.0
60      q_follow(:,:,1:2)=q(:,:,1:2) 
61      DO 1000 k = 1, llm
62        DO 1040 i = 1, ip1jmp1
63          if (seuil_liq - q(i,k,iq_liq) .gt. 0.d0 ) then
64
65              if (niso > 0) zx_defau_diag(i,k,iq_liq)=AMAX1
66     :               ( seuil_liq - q(i,k,iq_liq), 0.0 )
67
68             q(i,k,iq_vap) = q(i,k,iq_vap) + q(i,k,iq_liq) - seuil_liq
69             q(i,k,iq_liq) = seuil_liq
70           endif
71 1040   CONTINUE
72 1000 CONTINUE
73c
74c Quand l'eau vapeur est trop faible (ou negative), on complete
75c le defaut en prennant de l'eau vapeur de la couche au-dessous.
76c
77      iq = iq_vap
78c
79      DO k = llm, 2, -1
80ccc      zx_abc = dpres(k) / dpres(k-1)
81        DO i = 1, ip1jmp1
82          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
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 (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     
188c
189      RETURN
190      END
Note: See TracBrowser for help on using the repository browser.