source: LMDZ4/trunk/libf/phylmd/add_phys_tend.F90 @ 1040

Last change on this file since 1040 was 987, checked in by Laurent Fairhead, 16 years ago

Du nettoyage sur le parallelisme, inclusion de nouvelles interfaces pour OPA9
et ORCHIDEE YM
LF
  • 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 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.
40!$OMP THREADPRIVATE(first)
41INTEGER, SAVE :: itap
42!$OMP THREADPRIVATE(itap)
43!======================================================================
44! Initialisations
45
46debug_level=10
47     if (first) then
48        itap=0
49        first=.false.
50     endif
51! Incrementer le compteur de la physique
52     itap   = itap + 1
53!======================================================================
54! Ajout des tendances sur le vent et l'eau liquide
55!======================================================================
56
57     u_seri(:,:)=u_seri(:,:)+zdu(:,:)
58     v_seri(:,:)=v_seri(:,:)+zdv(:,:)
59     ql_seri(:,:)=ql_seri(:,:)+zdql(:,:)
60
61!======================================================================
62! On ajoute les tendances de la temperature et de la vapeur d'eau
63! en verifiant que ca ne part pas dans les choux
64!======================================================================
65
66      jbad=0
67      jqbad=0
68      DO k = 1, klev
69         DO i = 1, klon
70            zt=t_seri(i,k)+zdt(i,k)
71            zq=q_seri(i,k)+zdq(i,k)
72            IF ( zt>370. .or. zt<130. .or. abs(zdt(i,k))>50. ) then
73            jbad = jbad + 1
74            jadrs(jbad) = i
75            kadrs(jbad) = k
76            ENDIF
77            IF ( zq<0. .or. zq>0.1 .or. abs(zdq(i,k))>1.e-2 ) then
78            jqbad = jqbad + 1
79            jqadrs(jqbad) = i
80            kqadrs(jqbad) = k
81            ENDIF
82            t_seri(i,k)=zt
83            q_seri(i,k)=zq
84         ENDDO
85      ENDDO
86
87!=====================================================================================
88! Impression et stop en cas de probleme important
89!=====================================================================================
90
91IF (jbad .GT. 0) THEN
92      DO j = 1, jbad
93         i=jadrs(j)
94         print*,'PLANTAGE POUR LE POINT i rlon rlat =',i,rlon(i),rlat(i),text
95         print*,'l    T     dT       Q     dQ    '
96         DO k = 1, klev
97             write(*,'(i3,2f14.4,2e14.2)') k,t_seri(i,k),zdt(i,k),q_seri(i,k),zdq(i,k)
98         ENDDO
99         call print_debug_phys(i,debug_level,text)
100      ENDDO
101ENDIF
102!
103!=====================================================================================
104! Impression, warning et correction en cas de probleme moins important
105!=====================================================================================
106IF (jqbad .GT. 0) THEN
107      DO j = 1, jqbad
108         i=jqadrs(j)
109         print*,'WARNING  : EAU POUR LE POINT i rlon rlat =',i,rlon(i),rlat(i),text
110         print*,'l    T     dT       Q     dQ    '
111         DO k = 1, klev
112           zq=q_seri(i,k)+zdq(i,k)
113           if (zq.lt.1.e-15) then
114              if (q_seri(i,k).lt.1.e-15) then
115!              print*,' cas q_seri<1.e-15 i k q_seri zq zdq :',i,k,q_seri(i,k),zq,zdq(i,k)
116               q_seri(i,k)=1.e-15
117               zdq(i,k)=(1.e-15-q_seri(i,k))
118              endif
119           endif
120!           zq=q_seri(i,k)+zdq(i,k)
121!           if (zq.lt.1.e-15) then
122!              zdq(i,k)=(1.e-15-q_seri(i,k))
123!           endif
124         ENDDO
125      ENDDO
126ENDIF
127!
128
129!IM ajout memes tests pour reverifier les jbad, jqbad beg
130      jbad=0
131      jqbad=0
132      DO k = 1, klev
133         DO i = 1, klon
134            IF ( t_seri(i,k)>370. .or. t_seri(i,k)<130. .or. abs(zdt(i,k))>50. ) then
135            jbad = jbad + 1
136            jadrs(jbad) = i
137!           if(prt_level.ge.10) THEN
138!             print*,'cas2 i k t_seri zdt',i,k,t_seri(i,k),zdt(i,k)
139!           endif
140            ENDIF
141            IF ( q_seri(i,k)<0. .or. q_seri(i,k)>0.1 .or. abs(zdq(i,k))>1.e-2 ) then
142            jqbad = jqbad + 1
143            jqadrs(jqbad) = i
144            kqadrs(jqbad) = k
145!           if(prt_level.ge.10) THEN
146!             print*,'cas2 i k q_seri zdq',i,k,q_seri(i,k),zdq(i,k)
147!           endif
148            ENDIF
149         ENDDO
150      ENDDO
151IF (jbad .GT. 0) THEN
152      DO j = 1, jbad
153         i=jadrs(j)
154         k=kadrs(j)
155         print*,'PLANTAGE2 POUR LE POINT i itap rlon rlat txt jbad zdt t',i,itap,rlon(i),rlat(i),text,jbad, &
156       &        zdt(i,k),t_seri(i,k)-zdt(i,k)
157!        if(prt_level.ge.10) THEN
158         if(prt_level.ge.10.and.itap.GE.229.and.i.EQ.3027) THEN
159          print*,'l    T     dT       Q     dQ    '
160          DO k = 1, klev
161             write(*,'(i3,2f14.4,2e14.2)') k,t_seri(i,k),zdt(i,k),q_seri(i,k),zdq(i,k)
162          ENDDO
163          call print_debug_phys(i,debug_level,text)
164         endif
165      ENDDO
166ENDIF
167!
168IF (jqbad .GT. 0) THEN
169      DO j = 1, jqbad
170         i=jqadrs(j)
171         k=kqadrs(j)
172         print*,'WARNING  : EAU2 POUR LE POINT i itap rlon rlat txt jqbad zdq q zdql ql',i,itap,rlon(i),rlat(i),text,jqbad,&
173       &        zdq(i,k), q_seri(i,k)-zdq(i,k), zdql(i,k), ql_seri(i,k)-zdql(i,k)
174!        if(prt_level.ge.10) THEN
175         if(prt_level.ge.10.and.itap.GE.229.and.i.EQ.3027) THEN
176          print*,'l    T     dT       Q     dQ    '
177          DO k = 1, klev
178            write(*,'(i3,2f14.4,2e14.2)') k,t_seri(i,k),zdt(i,k),q_seri(i,k),zdq(i,k)
179          ENDDO
180          call print_debug_phys(i,debug_level,text)
181         endif
182      ENDDO
183ENDIF
184
185      CALL hgardfou(t_seri,ftsol,text)
186      RETURN
187      END
Note: See TracBrowser for help on using the repository browser.