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

Last change on this file since 5449 was 5222, checked in by abarral, 4 months ago

missing bits from r5199 merge
  • 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, addPhase
6  USE lmdz_strings, ONLY: strIdx
7  USE lmdz_ssum_scopy, ONLY: ssum
8
9  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
10  USE lmdz_paramet
11  USE lmdz_check_isotopes, ONLY: check_isotopes_seq
12
13  IMPLICIT NONE
14
15  !  -- Objet : Traiter les valeurs trop petites (meme negatives)
16  !         pour l'eau vapeur et l'eau liquide
17  !
18
19  INTEGER :: nqtot
20  REAL :: q(ip1jmp1, llm, nqtot), deltap(ip1jmp1, llm)
21
22  LOGICAL, SAVE :: first = .TRUE.
23  INTEGER, SAVE :: iq_vap, iq_liq        ! indices pour l'eau vapeur/liquide
24  REAL, PARAMETER :: seuil_vap = 1.0e-10 ! seuil pour l'eau vapeur
25  REAL, PARAMETER :: seuil_liq = 1.0e-11 ! seuil pour l'eau liquide
26
27  !  NB. ....( Il est souhaitable mais non obligatoire que les valeurs des
28  !        parametres seuil_vap, seuil_liq soient pareilles a celles
29  !        qui  sont utilisees dans la routine    ADDFI       )
30  ! .................................................................
31
32  !DC iq_val and iq_liq are usable for q only, NOT for q_follow
33  !   and zx_defau_diag (crash if iq_val/liq==3) => vapor/liquid
34  !   water at hardcoded indices 1/2 in these variables
35  INTEGER :: i, k, iq
36  REAL :: zx_defau, zx_abc, zx_pump(ip1jmp1), pompe
37
38  REAL :: zx_defau_diag(ip1jmp1, llm, 2)
39  REAL :: q_follow(ip1jmp1, llm, 2)
40
41  INTEGER :: imprim
42  SAVE imprim
43  DATA imprim /0/
44  !INTEGER ijb,ije
45  !INTEGER Index_pump(ij_end-ij_begin+1)
46  !INTEGER nb_pump
47  INTEGER :: ixt
48
49  IF(first) THEN
50    iq_vap = strIdx(tracers(:)%name, addPhase('H2O', 'g'))
51    iq_liq = strIdx(tracers(:)%name, addPhase('H2O', 'l'))
52    first = .FALSE.
53  END IF
54
55  ! Quand l'eau liquide est trop petite (ou negative), on prend
56  ! l'eau vapeur de la meme couche et la convertit en eau liquide
57  ! (sans changer la temperature !)
58  !
59
60  CALL check_isotopes_seq(q, ip1jmp1, 'qminimum 52')
61
62  zx_defau_diag(:, :, :) = 0.0
63  q_follow(:, :, 1) = q(:, :, iq_vap)
64  q_follow(:, :, 2) = q(:, :, iq_liq)
65  DO k = 1, llm
66    DO i = 1, ip1jmp1
67      IF (seuil_liq - q(i, k, iq_liq) > 0.d0) THEN
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        IF (niso > 0) zx_defau_diag(i, k, 1) &
85                = AMAX1(seuil_vap - q(i, k, iq_vap), 0.0)
86
87        q(i, k - 1, iq_vap) = q(i, k - 1, iq_vap) - (seuil_vap &
88                - q(i, k, iq_vap)) * deltap(i, k) / deltap(i, k - 1)
89        q(i, k, iq_vap) = seuil_vap
90
91      endif
92    ENDDO
93  ENDDO
94
95
96  ! Quand il s'agit de la premiere couche au-dessus du sol, on
97  ! doit imprimer un message d'avertissement (saturation possible).
98
99  DO i = 1, ip1jmp1
100    zx_pump(i) = AMAX1(0.0, seuil_vap - q(i, 1, iq_vap))
101    q(i, 1, iq_vap) = AMAX1(q(i, 1, iq_vap), seuil_vap)
102  ENDDO
103  pompe = SSUM(ip1jmp1, zx_pump, 1)
104  IF (imprim<=500 .AND. pompe>0.0) THEN
105    WRITE(6, '(1x,"ATT!:on pompe de l eau au sol",e15.7)') pompe
106    DO i = 1, ip1jmp1
107      IF (zx_pump(i)>0.0) THEN
108        imprim = imprim + 1
109        PRINT*, 'QMINIMUM:  en ', i, zx_pump(i)
110      ENDIF
111    ENDDO
112  ENDIF
113
114  !WRITE(*,*) 'qminimum 128'
115  IF (niso > 0) THEN
116    ! CRisi: traiter de même les traceurs d'eau
117    ! Mais il faut les prendre à l'envers pour essayer de conserver la
118    ! masse.
119    ! 1) pompage dans le sol
120    ! On suppose que ce pompage se fait sans isotopes -> on ne modifie
121    ! rien ici et on croise les doigts pour que ça ne soit pas trop
122    ! génant
123    DO i = 1, ip1jmp1
124      IF (zx_pump(i)>0.0) THEN
125        q_follow(i, 1, 1) = q_follow(i, 1, 1) + zx_pump(i)
126      endif !if (zx_pump(i).gt.0.0) THEN
127    enddo !DO i = 1,ip1jmp1
128
129    ! 2) transfert de vap vers les couches plus hautes
130    !WRITE(*,*) 'qminimum 139'
131    DO k = 2, llm
132      DO i = 1, ip1jmp1
133        IF (zx_defau_diag(i, k, 1)>0.0) THEN
134          ! on ajoute la vapeur en k
135          DO ixt = 1, ntiso
136            q(i, k, iqIsoPha(ixt, iq_vap)) = q(i, k, iqIsoPha(ixt, iq_vap)) &
137                    + zx_defau_diag(i, k, 1) &
138                            * q(i, k - 1, iqIsoPha(ixt, iq_vap)) / q_follow(i, k - 1, 1)
139
140            ! et on la retranche en k-1
141            q(i, k - 1, iqIsoPha(ixt, iq_vap)) = &
142                    q(i, k - 1, iqIsoPha(ixt, iq_vap)) &
143                            - zx_defau_diag(i, k, 1) &
144                            * deltap(i, k) / deltap(i, k - 1) &
145                            * q(i, k - 1, iqIsoPha(ixt, iq_vap)) &
146                            / q_follow(i, k - 1, 1)
147
148          enddo !do ixt=1,niso
149          q_follow(i, k, 1) = q_follow(i, k, 1) &
150                  + zx_defau_diag(i, k, 1)
151          q_follow(i, k - 1, 1) = q_follow(i, k - 1, 1) &
152                  - zx_defau_diag(i, k, 1) &
153                          * deltap(i, k) / deltap(i, k - 1)
154        endif !if (zx_defau_diag(i,k,1).gt.0.0) THEN
155      enddo !DO i = 1, ip1jmp1
156    enddo !do k=2,llm
157
158    CALL check_isotopes_seq(q, ip1jmp1, 'qminimum 168')
159
160
161    ! 3) transfert d'eau de la vapeur au liquide
162    !WRITE(*,*) 'qminimum 164'
163    DO k = 1, llm
164      DO i = 1, ip1jmp1
165        IF (zx_defau_diag(i, k, 2)>0.0) THEN
166          ! ! on ajoute eau liquide en k en k
167          DO ixt = 1, ntiso
168            q(i, k, iqIsoPha(ixt, iq_liq)) = q(i, k, iqIsoPha(ixt, iq_liq)) &
169                    + zx_defau_diag(i, k, 2) &
170                            * q(i, k, iqIsoPha(ixt, iq_vap)) / q_follow(i, k, 1)
171            ! ! et on la retranche à la vapeur en k
172            q(i, k, iqIsoPha(ixt, iq_vap)) = q(i, k, iqIsoPha(ixt, iq_vap)) &
173                    - zx_defau_diag(i, k, 2) &
174                            * q(i, k, iqIsoPha(ixt, iq_vap)) / q_follow(i, k, 1)
175          enddo !do ixt=1,niso
176          q_follow(i, k, 2) = q_follow(i, k, 2) &
177                  + zx_defau_diag(i, k, 2)
178          q_follow(i, k, 1) = q_follow(i, k, 1) &
179                  - zx_defau_diag(i, k, 2)
180        endif !if (zx_defau_diag(i,k,1).gt.0.0) THEN
181      enddo !DO i = 1, ip1jmp1
182    enddo !do k=2,llm
183
184    CALL check_isotopes_seq(q, ip1jmp1, 'qminimum 197')
185
186  ENDIF !if (niso > 0) THEN
187  ! !WRITE(*,*) 'qminimum 188'
188
189  !
190
191END SUBROUTINE qminimum
Note: See TracBrowser for help on using the repository browser.