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

Last change on this file since 5209 was 5186, checked in by abarral, 9 days ago

Encapsulate files in modules
  • 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 lmdz_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  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
11  USE lmdz_paramet
12  USE lmdz_check_isotopes, ONLY: check_isotopes_seq
13
14  IMPLICIT NONE
15
16  !  -- Objet : Traiter les valeurs trop petites (meme negatives)
17  !         pour l'eau vapeur et l'eau liquide
18  !
19
20  INTEGER :: nqtot
21  REAL :: q(ip1jmp1, llm, nqtot), deltap(ip1jmp1, llm)
22
23  LOGICAL, SAVE :: first = .TRUE.
24  INTEGER, SAVE :: iq_vap, iq_liq        ! indices pour l'eau vapeur/liquide
25  REAL, PARAMETER :: seuil_vap = 1.0e-10 ! seuil pour l'eau vapeur
26  REAL, PARAMETER :: seuil_liq = 1.0e-11 ! seuil pour l'eau liquide
27
28  !  NB. ....( Il est souhaitable mais non obligatoire que les valeurs des
29  !        parametres seuil_vap, seuil_liq soient pareilles a celles
30  !        qui  sont utilisees dans la routine    ADDFI       )
31  ! .................................................................
32
33  !DC iq_val and iq_liq are usable for q only, NOT for q_follow
34  !   and zx_defau_diag (crash if iq_val/liq==3) => vapor/liquid
35  !   water at hardcoded indices 1/2 in these variables
36  INTEGER :: i, k, iq
37  REAL :: zx_defau, zx_abc, zx_pump(ip1jmp1), pompe
38
39  REAL :: zx_defau_diag(ip1jmp1, llm, 2)
40  REAL :: q_follow(ip1jmp1, llm, 2)
41
42  INTEGER :: imprim
43  SAVE imprim
44  DATA imprim /0/
45  !INTEGER ijb,ije
46  !INTEGER Index_pump(ij_end-ij_begin+1)
47  !INTEGER nb_pump
48  INTEGER :: ixt
49
50  IF(first) THEN
51    iq_vap = strIdx(tracers(:)%name, addPhase('H2O', 'g'))
52    iq_liq = strIdx(tracers(:)%name, addPhase('H2O', 'l'))
53    first = .FALSE.
54  END IF
55
56  ! Quand l'eau liquide est trop petite (ou negative), on prend
57  ! l'eau vapeur de la meme couche et la convertit en eau liquide
58  ! (sans changer la temperature !)
59  !
60
61  CALL check_isotopes_seq(q, ip1jmp1, 'qminimum 52')
62
63  zx_defau_diag(:, :, :) = 0.0
64  q_follow(:, :, 1) = q(:, :, iq_vap)
65  q_follow(:, :, 2) = q(:, :, iq_liq)
66  DO k = 1, llm
67    DO i = 1, ip1jmp1
68      IF (seuil_liq - q(i, k, iq_liq) > 0.d0) THEN
69        IF (niso > 0) zx_defau_diag(i, k, 2) = AMAX1 &
70                (seuil_liq - q(i, k, iq_liq), 0.0)
71
72        q(i, k, iq_vap) = q(i, k, iq_vap) + q(i, k, iq_liq) - seuil_liq
73        q(i, k, iq_liq) = seuil_liq
74      endif
75    ENDDO
76  ENDDO
77
78  ! Quand l'eau vapeur est trop faible (ou negative), on complete
79  ! le defaut en prennant de l'eau vapeur de la couche au-dessous.
80
81  DO k = llm, 2, -1
82    !cc      zx_abc = dpres(k) / dpres(k-1)
83    DO i = 1, ip1jmp1
84      IF (seuil_vap - q(i, k, iq_vap) > 0.d0) THEN
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          ! ! on ajoute eau liquide en k en k
168          DO ixt = 1, ntiso
169            q(i, k, iqIsoPha(ixt, iq_liq)) = q(i, k, iqIsoPha(ixt, iq_liq)) &
170                    + zx_defau_diag(i, k, 2) &
171                            * q(i, k, iqIsoPha(ixt, iq_vap)) / q_follow(i, k, 1)
172            ! ! et on la retranche à la vapeur en k
173            q(i, k, iqIsoPha(ixt, iq_vap)) = q(i, k, iqIsoPha(ixt, iq_vap)) &
174                    - zx_defau_diag(i, k, 2) &
175                            * q(i, k, iqIsoPha(ixt, iq_vap)) / q_follow(i, k, 1)
176          enddo !do ixt=1,niso
177          q_follow(i, k, 2) = q_follow(i, k, 2) &
178                  + zx_defau_diag(i, k, 2)
179          q_follow(i, k, 1) = q_follow(i, k, 1) &
180                  - zx_defau_diag(i, k, 2)
181        endif !if (zx_defau_diag(i,k,1).gt.0.0) THEN
182      enddo !DO i = 1, ip1jmp1
183    enddo !do k=2,llm
184
185    CALL check_isotopes_seq(q, ip1jmp1, 'qminimum 197')
186
187  ENDIF !if (niso > 0) THEN
188  ! !WRITE(*,*) 'qminimum 188'
189
190  !
191
192END SUBROUTINE qminimum
Note: See TracBrowser for help on using the repository browser.