source: LMDZ6/branches/Amaury_dev/libf/dyn3d/qminimum.F90 @ 5157

Last change on this file since 5157 was 5134, checked in by abarral, 8 weeks ago

Replace academic.h, alpale.h, comdissip.h, comdissipn.h, comdissnew.h by modules
Remove unused clesph0.h
  • 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! $Header$
2
3SUBROUTINE qminimum(q, nqtot, deltap)
4
5  USE infotrac, ONLY: niso, ntiso, iqIsoPha, tracers
6  USE lmdz_strings, ONLY: strIdx
7  USE lmdz_readTracFiles, ONLY: addPhase
8  USE lmdz_ssum_scopy, ONLY: ssum
9
10  IMPLICIT NONE
11  !
12  !  -- Objet : Traiter les valeurs trop petites (meme negatives)
13  !         pour l'eau vapeur et l'eau liquide
14  !
15  INCLUDE "dimensions.h"
16  INCLUDE "paramet.h"
17  !
18  INTEGER :: nqtot
19  REAL :: q(ip1jmp1, llm, nqtot), deltap(ip1jmp1, llm)
20  !
21  LOGICAL, SAVE :: first = .TRUE.
22  INTEGER, SAVE :: iq_vap, iq_liq        ! indices pour l'eau vapeur/liquide
23  REAL, PARAMETER :: seuil_vap = 1.0e-10 ! seuil pour l'eau vapeur
24  REAL, PARAMETER :: seuil_liq = 1.0e-11 ! seuil pour l'eau liquide
25  !
26  !  NB. ....( Il est souhaitable mais non obligatoire que les valeurs des
27  !        parametres seuil_vap, seuil_liq soient pareilles a celles
28  !        qui  sont utilisees dans la routine    ADDFI       )
29  ! .................................................................
30  !
31  !DC iq_val and iq_liq are usable for q only, NOT for q_follow
32  !   and zx_defau_diag (crash if iq_val/liq==3) => vapor/liquid
33  !   water at hardcoded indices 1/2 in these variables
34  INTEGER :: i, k, iq
35  REAL :: zx_defau, zx_abc, zx_pump(ip1jmp1), pompe
36
37  REAL :: zx_defau_diag(ip1jmp1, llm, 2)
38  REAL :: q_follow(ip1jmp1, llm, 2)
39  !
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
53  !
54  ! Quand l'eau liquide est trop petite (ou negative), on prend
55  ! l'eau vapeur de la meme couche et la convertit en eau liquide
56  ! (sans changer la temperature !)
57  !
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) > 0.d0) THEN
67        IF (niso > 0) zx_defau_diag(i, k, 2) = AMAX1 &
68                (seuil_liq - q(i, k, iq_liq), 0.0)
69
70        q(i, k, iq_vap) = q(i, k, iq_vap) + q(i, k, iq_liq) - seuil_liq
71        q(i, k, iq_liq) = seuil_liq
72      endif
73    ENDDO
74  ENDDO
75  !
76  ! Quand l'eau vapeur est trop faible (ou negative), on complete
77  ! le defaut en prennant de l'eau vapeur de la couche au-dessous.
78  !
79  DO k = llm, 2, -1
80    !cc      zx_abc = dpres(k) / dpres(k-1)
81    DO i = 1, ip1jmp1
82      IF (seuil_vap - q(i, k, iq_vap) > 0.d0) THEN
83        IF (niso > 0) zx_defau_diag(i, k, 1) &
84                = AMAX1(seuil_vap - q(i, k, iq_vap), 0.0)
85
86        q(i, k - 1, iq_vap) = q(i, k - 1, iq_vap) - (seuil_vap &
87                - q(i, k, iq_vap)) * deltap(i, k) / deltap(i, k - 1)
88        q(i, k, iq_vap) = seuil_vap
89
90      endif
91    ENDDO
92  ENDDO
93
94  !
95  ! Quand il s'agit de la premiere couche au-dessus du sol, on
96  ! doit imprimer un message d'avertissement (saturation possible).
97  !
98  DO i = 1, ip1jmp1
99    zx_pump(i) = AMAX1(0.0, seuil_vap - q(i, 1, iq_vap))
100    q(i, 1, iq_vap) = AMAX1(q(i, 1, iq_vap), seuil_vap)
101  ENDDO
102  pompe = SSUM(ip1jmp1, zx_pump, 1)
103  IF (imprim<=500 .AND. pompe>0.0) THEN
104    WRITE(6, '(1x,"ATT!:on pompe de l eau au sol",e15.7)') pompe
105    DO i = 1, ip1jmp1
106      IF (zx_pump(i)>0.0) THEN
107        imprim = imprim + 1
108        PRINT*, 'QMINIMUM:  en ', i, zx_pump(i)
109      ENDIF
110    ENDDO
111  ENDIF
112
113  !WRITE(*,*) 'qminimum 128'
114  IF (niso > 0) THEN
115    ! CRisi: traiter de même les traceurs d'eau
116    ! Mais il faut les prendre à l'envers pour essayer de conserver la
117    ! masse.
118    ! 1) pompage dans le sol
119    ! On suppose que ce pompage se fait sans isotopes -> on ne modifie
120    ! rien ici et on croise les doigts pour que ça ne soit pas trop
121    ! génant
122    DO i = 1, ip1jmp1
123      IF (zx_pump(i)>0.0) THEN
124        q_follow(i, 1, 1) = q_follow(i, 1, 1) + zx_pump(i)
125      endif !if (zx_pump(i).gt.0.0) THEN
126    enddo !DO i = 1,ip1jmp1
127
128    ! 2) transfert de vap vers les couches plus hautes
129    !WRITE(*,*) 'qminimum 139'
130    do k = 2, llm
131      DO i = 1, ip1jmp1
132        IF (zx_defau_diag(i, k, 1)>0.0) THEN
133          ! on ajoute la vapeur en k
134          do ixt = 1, ntiso
135            q(i, k, iqIsoPha(ixt, iq_vap)) = q(i, k, iqIsoPha(ixt, iq_vap)) &
136                    + zx_defau_diag(i, k, 1) &
137                            * q(i, k - 1, iqIsoPha(ixt, iq_vap)) / q_follow(i, k - 1, 1)
138
139            ! et on la retranche en k-1
140            q(i, k - 1, iqIsoPha(ixt, iq_vap)) = &
141                    q(i, k - 1, iqIsoPha(ixt, iq_vap)) &
142                            - zx_defau_diag(i, k, 1) &
143                            * deltap(i, k) / deltap(i, k - 1) &
144                            * q(i, k - 1, iqIsoPha(ixt, iq_vap)) &
145                            / q_follow(i, k - 1, 1)
146
147          enddo !do ixt=1,niso
148          q_follow(i, k, 1) = q_follow(i, k, 1) &
149                  + zx_defau_diag(i, k, 1)
150          q_follow(i, k - 1, 1) = q_follow(i, k - 1, 1) &
151                  - zx_defau_diag(i, k, 1) &
152                          * deltap(i, k) / deltap(i, k - 1)
153        endif !if (zx_defau_diag(i,k,1).gt.0.0) THEN
154      enddo !DO i = 1, ip1jmp1
155    enddo !do k=2,llm
156
157    CALL check_isotopes_seq(q, ip1jmp1, 'qminimum 168')
158
159
160    ! 3) transfert d'eau de la vapeur au liquide
161    !WRITE(*,*) 'qminimum 164'
162    do k = 1, llm
163      DO i = 1, ip1jmp1
164        IF (zx_defau_diag(i, k, 2)>0.0) THEN
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, 2) &
169                            * q(i, k, iqIsoPha(ixt, iq_vap)) / q_follow(i, k, 1)
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, 2) &
173                            * q(i, k, iqIsoPha(ixt, iq_vap)) / q_follow(i, k, 1)
174          enddo !do ixt=1,niso
175          q_follow(i, k, 2) = q_follow(i, k, 2) &
176                  + zx_defau_diag(i, k, 2)
177          q_follow(i, k, 1) = q_follow(i, k, 1) &
178                  - zx_defau_diag(i, k, 2)
179        endif !if (zx_defau_diag(i,k,1).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  !
189
190END SUBROUTINE qminimum
Note: See TracBrowser for help on using the repository browser.