source: LMDZ4/tags/LF_20080728/libf/phylmd/add_phys_tend.F90 @ 3289

Last change on this file since 3289 was 972, checked in by lmdzadmin, 16 years ago

Version thermique FH/CRio
Ajout tests cas physiques non pris en comptes et ajout/enleve prints
Nouvelle routine thermcell_flux2.F90
IM
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 5.9 KB
Line 
1!
2! $Header$
3!
4SUBROUTINE add_phys_tend (zdu,zdv,zdt,zdq,zdql,text)
5!======================================================================
6! Ajoute les tendances des variables physiques aux variables
7! d'etat de la dynamique t_seri, q_seri ...
8! On en profite pour faire des tests sur les tendances en question.
9!======================================================================
10
11
12!======================================================================
13! Declarations
14!======================================================================
15
16use dimphy
17use phys_local_var_mod
18use phys_state_var_mod
19IMPLICIT none
20#include "iniprint.h"
21
22! Arguments :
23!------------
24REAL zdu(klon,klev),zdv(klon,klev)
25REAL zdt(klon,klev),zdq(klon,klev),zdql(klon,klev)
26CHARACTER*(*) text
27
28! Local :
29!--------
30REAL zt,zq
31
32INTEGER i, k,j
33INTEGER jadrs(klon*klev), jbad
34INTEGER jqadrs(klon*klev), jqbad
35INTEGER kadrs(klon*klev)
36INTEGER kqadrs(klon*klev)
37
38integer debug_level
39logical, save :: first=.true.
40INTEGER, SAVE :: itap
41!======================================================================
42! Initialisations
43
44debug_level=10
45     if (first) then
46        itap=0
47        first=.false.
48     endif
49! Incrementer le compteur de la physique
50     itap   = itap + 1
51!======================================================================
52! Ajout des tendances sur le vent et l'eau liquide
53!======================================================================
54
55     u_seri(:,:)=u_seri(:,:)+zdu(:,:)
56     v_seri(:,:)=v_seri(:,:)+zdv(:,:)
57     ql_seri(:,:)=ql_seri(:,:)+zdql(:,:)
58
59!======================================================================
60! On ajoute les tendances de la temperature et de la vapeur d'eau
61! en verifiant que ca ne part pas dans les choux
62!======================================================================
63
64      jbad=0
65      jqbad=0
66      DO k = 1, klev
67         DO i = 1, klon
68            zt=t_seri(i,k)+zdt(i,k)
69            zq=q_seri(i,k)+zdq(i,k)
70            IF ( zt>370. .or. zt<130. .or. abs(zdt(i,k))>50. ) then
71            jbad = jbad + 1
72            jadrs(jbad) = i
73            kadrs(jbad) = k
74            ENDIF
75            IF ( zq<0. .or. zq>0.1 .or. abs(zdq(i,k))>1.e-2 ) then
76            jqbad = jqbad + 1
77            jqadrs(jqbad) = i
78            kqadrs(jqbad) = k
79            ENDIF
80            t_seri(i,k)=zt
81            q_seri(i,k)=zq
82         ENDDO
83      ENDDO
84
85!=====================================================================================
86! Impression et stop en cas de probleme important
87!=====================================================================================
88
89IF (jbad .GT. 0) THEN
90      DO j = 1, jbad
91         i=jadrs(j)
92         print*,'PLANTAGE POUR LE POINT i rlon rlat =',i,rlon(i),rlat(i),text
93         print*,'l    T     dT       Q     dQ    '
94         DO k = 1, klev
95             write(*,'(i3,2f14.4,2e14.2)') k,t_seri(i,k),zdt(i,k),q_seri(i,k),zdq(i,k)
96         ENDDO
97         call print_debug_phys(i,debug_level,text)
98      ENDDO
99ENDIF
100!
101!=====================================================================================
102! Impression, warning et correction en cas de probleme moins important
103!=====================================================================================
104IF (jqbad .GT. 0) THEN
105      DO j = 1, jqbad
106         i=jqadrs(j)
107         print*,'WARNING  : EAU POUR LE POINT i rlon rlat =',i,rlon(i),rlat(i),text
108         print*,'l    T     dT       Q     dQ    '
109         DO k = 1, klev
110           zq=q_seri(i,k)+zdq(i,k)
111           if (zq.lt.1.e-15) then
112              if (q_seri(i,k).lt.1.e-15) then
113!              print*,' cas q_seri<1.e-15 i k q_seri zq zdq :',i,k,q_seri(i,k),zq,zdq(i,k)
114               q_seri(i,k)=1.e-15
115               zdq(i,k)=(1.e-15-q_seri(i,k))
116              endif
117           endif
118!           zq=q_seri(i,k)+zdq(i,k)
119!           if (zq.lt.1.e-15) then
120!              zdq(i,k)=(1.e-15-q_seri(i,k))
121!           endif
122         ENDDO
123      ENDDO
124ENDIF
125!
126
127!IM ajout memes tests pour reverifier les jbad, jqbad beg
128      jbad=0
129      jqbad=0
130      DO k = 1, klev
131         DO i = 1, klon
132            IF ( t_seri(i,k)>370. .or. t_seri(i,k)<130. .or. abs(zdt(i,k))>50. ) then
133            jbad = jbad + 1
134            jadrs(jbad) = i
135!           if(prt_level.ge.10) THEN
136!             print*,'cas2 i k t_seri zdt',i,k,t_seri(i,k),zdt(i,k)
137!           endif
138            ENDIF
139            IF ( q_seri(i,k)<0. .or. q_seri(i,k)>0.1 .or. abs(zdq(i,k))>1.e-2 ) then
140            jqbad = jqbad + 1
141            jqadrs(jqbad) = i
142            kqadrs(jqbad) = k
143!           if(prt_level.ge.10) THEN
144!             print*,'cas2 i k q_seri zdq',i,k,q_seri(i,k),zdq(i,k)
145!           endif
146            ENDIF
147         ENDDO
148      ENDDO
149IF (jbad .GT. 0) THEN
150      DO j = 1, jbad
151         i=jadrs(j)
152         k=kadrs(j)
153         print*,'PLANTAGE2 POUR LE POINT i itap rlon rlat txt jbad zdt t',i,itap,rlon(i),rlat(i),text,jbad, &
154       &        zdt(i,k),t_seri(i,k)-zdt(i,k)
155!        if(prt_level.ge.10) THEN
156         if(prt_level.ge.10.and.itap.GE.229.and.i.EQ.3027) THEN
157          print*,'l    T     dT       Q     dQ    '
158          DO k = 1, klev
159             write(*,'(i3,2f14.4,2e14.2)') k,t_seri(i,k),zdt(i,k),q_seri(i,k),zdq(i,k)
160          ENDDO
161          call print_debug_phys(i,debug_level,text)
162         endif
163      ENDDO
164ENDIF
165!
166IF (jqbad .GT. 0) THEN
167      DO j = 1, jqbad
168         i=jqadrs(j)
169         k=kqadrs(j)
170         print*,'WARNING  : EAU2 POUR LE POINT i itap rlon rlat txt jqbad zdq q zdql ql',i,itap,rlon(i),rlat(i),text,jqbad,&
171       &        zdq(i,k), q_seri(i,k)-zdq(i,k), zdql(i,k), ql_seri(i,k)-zdql(i,k)
172!        if(prt_level.ge.10) THEN
173         if(prt_level.ge.10.and.itap.GE.229.and.i.EQ.3027) THEN
174          print*,'l    T     dT       Q     dQ    '
175          DO k = 1, klev
176            write(*,'(i3,2f14.4,2e14.2)') k,t_seri(i,k),zdt(i,k),q_seri(i,k),zdq(i,k)
177          ENDDO
178          call print_debug_phys(i,debug_level,text)
179         endif
180      ENDDO
181ENDIF
182
183      CALL hgardfou(t_seri,ftsol,text)
184      RETURN
185      END
Note: See TracBrowser for help on using the repository browser.