source: LMDZ6/trunk/libf/dyn3d/qminimum.f90 @ 5447

Last change on this file since 5447 was 5285, checked in by abarral, 8 weeks ago

As discussed internally, remove generic ONLY: ... for new _mod_h 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.0 KB
Line 
1!
2! $Header$
3!
4SUBROUTINE qminimum( q,nqtot,deltap )
5
6  USE infotrac, ONLY: niso, ntiso, iqIsoPha, tracers, addPhase
7  USE strings_mod, ONLY: strIdx
8  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
9USE paramet_mod_h
10IMPLICIT none
11  !
12  !  -- Objet : Traiter les valeurs trop petites (meme negatives)
13  !         pour l'eau vapeur et l'eau liquide
14  !
15
16
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  REAL :: SSUM
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) .gt. 0.d0 ) then
69
70        if (niso > 0) zx_defau_diag(i,k,2)=AMAX1 &
71              ( seuil_liq - q(i,k,iq_liq), 0.0 )
72
73        q(i,k,iq_vap) = q(i,k,iq_vap) + q(i,k,iq_liq) - seuil_liq
74        q(i,k,iq_liq) = seuil_liq
75      endif
76    ENDDO
77  ENDDO
78  !
79  ! Quand l'eau vapeur est trop faible (ou negative), on complete
80  ! le defaut en prennant de l'eau vapeur de la couche au-dessous.
81  !
82  DO k = llm, 2, -1
83  !cc      zx_abc = dpres(k) / dpres(k-1)
84    DO i = 1, ip1jmp1
85      if ( seuil_vap - q(i,k,iq_vap) .gt. 0.d0 ) then
86
87        if (niso > 0) zx_defau_diag(i,k,1) &
88              = AMAX1( seuil_vap - q(i,k,iq_vap), 0.0 )
89
90        q(i,k-1,iq_vap) = q(i,k-1,iq_vap) - (seuil_vap &
91              -q(i,k,iq_vap)) * deltap(i,k)/deltap(i,k-1)
92        q(i,k,iq_vap)   =  seuil_vap
93
94      endif
95    ENDDO
96  ENDDO
97
98  !
99  ! Quand il s'agit de la premiere couche au-dessus du sol, on
100  ! doit imprimer un message d'avertissement (saturation possible).
101  !
102  DO i = 1, ip1jmp1
103     zx_pump(i) = AMAX1( 0.0, seuil_vap - q(i,1,iq_vap) )
104     q(i,1,iq_vap)  = AMAX1( q(i,1,iq_vap), seuil_vap )
105  ENDDO
106  pompe = SSUM(ip1jmp1,zx_pump,1)
107  IF (imprim.LE.500 .AND. pompe.GT.0.0) THEN
108     WRITE(6,'(1x,"ATT!:on pompe de l eau au sol",e15.7)') pompe
109     DO i = 1, ip1jmp1
110        IF (zx_pump(i).GT.0.0) THEN
111           imprim = imprim + 1
112           PRINT*,'QMINIMUM:  en ',i,zx_pump(i)
113        ENDIF
114     ENDDO
115  ENDIF
116
117  ! !write(*,*) 'qminimum 128'
118  if (niso > 0) then
119  ! ! CRisi: traiter de même les traceurs d'eau
120  ! ! Mais il faut les prendre à l'envers pour essayer de conserver la
121  ! ! masse.
122  ! ! 1) pompage dans le sol
123  ! ! On suppose que ce pompage se fait sans isotopes -> on ne modifie
124  ! ! rien ici et on croise les doigts pour que ça ne soit pas trop
125  ! ! génant
126  DO i = 1,ip1jmp1
127    if (zx_pump(i).gt.0.0) then
128      q_follow(i,1,1)=q_follow(i,1,1)+zx_pump(i)
129    endif !if (zx_pump(i).gt.0.0) then
130  enddo !DO i = 1,ip1jmp1
131
132  ! ! 2) transfert de vap vers les couches plus hautes
133  ! !write(*,*) 'qminimum 139'
134  do k=2,llm
135    DO i = 1,ip1jmp1
136      if (zx_defau_diag(i,k,1).gt.0.0) then
137          ! ! on ajoute la vapeur en k
138          do ixt=1,ntiso
139           q(i,k,iqIsoPha(ixt,iq_vap))=q(i,k,iqIsoPha(ixt,iq_vap)) &
140                 +zx_defau_diag(i,k,1) &
141                 *q(i,k-1,iqIsoPha(ixt,iq_vap))/q_follow(i,k-1,1)
142
143          ! ! et on la retranche en k-1
144           q(i,k-1,iqIsoPha(ixt,iq_vap))= &
145                 q(i,k-1,iqIsoPha(ixt,iq_vap)) &
146                 -zx_defau_diag(i,k,1) &
147                 *deltap(i,k)/deltap(i,k-1) &
148                 *q(i,k-1,iqIsoPha(ixt,iq_vap)) &
149                 /q_follow(i,k-1,1)
150
151          enddo !do ixt=1,niso
152          q_follow(i,k,1)=   q_follow(i,k,1) &
153                +zx_defau_diag(i,k,1)
154          q_follow(i,k-1,1)=   q_follow(i,k-1,1) &
155                -zx_defau_diag(i,k,1) &
156                *deltap(i,k)/deltap(i,k-1)
157      endif !if (zx_defau_diag(i,k,1).gt.0.0) then
158    enddo !DO i = 1, ip1jmp1
159   enddo !do k=2,llm
160
161   call check_isotopes_seq(q,ip1jmp1,'qminimum 168')
162
163
164    ! ! 3) transfert d'eau de la vapeur au liquide
165    ! !write(*,*) 'qminimum 164'
166    do k=1,llm
167    DO i = 1,ip1jmp1
168      if (zx_defau_diag(i,k,2).gt.0.0) then
169
170          ! ! on ajoute eau liquide en k en k
171          do ixt=1,ntiso
172           q(i,k,iqIsoPha(ixt,iq_liq))=q(i,k,iqIsoPha(ixt,iq_liq)) &
173                 +zx_defau_diag(i,k,2) &
174                 *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,1)
175          ! ! et on la retranche à la vapeur en k
176           q(i,k,iqIsoPha(ixt,iq_vap))=q(i,k,iqIsoPha(ixt,iq_vap)) &
177                 -zx_defau_diag(i,k,2) &
178                 *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,1)
179          enddo !do ixt=1,niso
180          q_follow(i,k,2)=   q_follow(i,k,2) &
181                +zx_defau_diag(i,k,2)
182          q_follow(i,k,1)=   q_follow(i,k,1) &
183                -zx_defau_diag(i,k,2)
184      endif !if (zx_defau_diag(i,k,1).gt.0.0) then
185    enddo !DO i = 1, ip1jmp1
186   enddo !do k=2,llm
187
188   call check_isotopes_seq(q,ip1jmp1,'qminimum 197')
189
190  endif !if (niso > 0) then
191  ! !write(*,*) 'qminimum 188'
192
193  !
194  RETURN
195END SUBROUTINE qminimum
Note: See TracBrowser for help on using the repository browser.