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

Last change on this file since 5115 was 5113, checked in by abarral, 4 months ago

Rename modules in misc from *_mod > lmdz_*
Put cbrt.f90, ch*.f90, pch*.f90 in new lmdz_libmath_pch.f90
  • 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 strings_mod, ONLY: strIdx
7  USE readTracFiles_mod, ONLY: addPhase
8  IMPLICIT none
9  !
10  !  -- Objet : Traiter les valeurs trop petites (meme negatives)
11  !         pour l'eau vapeur et l'eau liquide
12  !
13  include "dimensions.h"
14  include "paramet.h"
15  !
16  INTEGER :: nqtot
17  REAL :: q(ip1jmp1, llm, nqtot), deltap(ip1jmp1, llm)
18  !
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
23  !
24  !  NB. ....( Il est souhaitable mais non obligatoire que les valeurs des
25  !        parametres seuil_vap, seuil_liq soient pareilles a celles
26  !        qui  sont utilisees dans la routine    ADDFI       )
27  ! .................................................................
28  !
29  !DC iq_val and iq_liq are usable for q only, NOT for q_follow
30  !   and zx_defau_diag (crash if iq_val/liq==3) => vapor/liquid
31  !   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)
37  !
38  REAL :: SSUM
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
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
76  !
77  ! Quand l'eau vapeur est trop faible (ou negative), on complete
78  ! le defaut en prennant de l'eau vapeur de la couche au-dessous.
79  !
80  DO k = llm, 2, -1
81    !cc      zx_abc = dpres(k) / dpres(k-1)
82    DO i = 1, ip1jmp1
83      if (seuil_vap - q(i, k, iq_vap) > 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
96  !
97  ! Quand il s'agit de la premiere couche au-dessus du sol, on
98  ! doit imprimer un message d'avertissement (saturation possible).
99  !
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<=500 .AND. pompe>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)>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)>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)>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)>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
191  !
192
193END SUBROUTINE qminimum
Note: See TracBrowser for help on using the repository browser.