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

Last change on this file was 5246, checked in by abarral, 23 hours ago

Convert fixed-form to free-form sources .F -> .{f,F}90
(WIP: some .F remain, will be handled in subsequent commits)
  • 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  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) .gt. 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) .gt. 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.LE.500 .AND. pompe.GT.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).GT.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).gt.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).gt.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).gt.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  RETURN
193END SUBROUTINE qminimum
Note: See TracBrowser for help on using the repository browser.