source: LMDZ5/trunk/libf/phylmd/add_phys_tend.F90 @ 1957

Last change on this file since 1957 was 1907, checked in by lguez, 11 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
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

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.
  • 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.2 KB
Line 
1!
2! $Id: add_phys_tend.F90 1907 2013-11-26 13:10:46Z fairhead $
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         if(prt_level.ge.debug_level) THEN
95          print*,'PLANTAGE POUR LE POINT i rlon rlat =',i,rlon(i),rlat(i),text
96          print*,'l    T     dT       Q     dQ    '
97          DO k = 1, klev
98             write(*,'(i3,2f14.4,2e14.2)') k,t_seri(i,k),zdt(i,k),q_seri(i,k),zdq(i,k)
99          ENDDO
100          call print_debug_phys(i,debug_level,text)
101         endif
102      ENDDO
103ENDIF
104!
105!=====================================================================================
106! Impression, warning et correction en cas de probleme moins important
107!=====================================================================================
108IF (jqbad .GT. 0) THEN
109      DO j = 1, jqbad
110         i=jqadrs(j)
111         if(prt_level.ge.debug_level) THEN
112          print*,'WARNING  : EAU POUR LE POINT i rlon rlat =',i,rlon(i),rlat(i),text
113          print*,'l    T     dT       Q     dQ    '
114         endif
115         DO k = 1, klev
116           zq=q_seri(i,k)+zdq(i,k)
117           if (zq.lt.1.e-15) then
118              if (q_seri(i,k).lt.1.e-15) then
119               if(prt_level.ge.debug_level) THEN
120                print*,' cas q_seri<1.e-15 i k q_seri zq zdq :',i,k,q_seri(i,k),zq,zdq(i,k)
121               endif
122               q_seri(i,k)=1.e-15
123               zdq(i,k)=(1.e-15-q_seri(i,k))
124              endif
125           endif
126!           zq=q_seri(i,k)+zdq(i,k)
127!           if (zq.lt.1.e-15) then
128!              zdq(i,k)=(1.e-15-q_seri(i,k))
129!           endif
130         ENDDO
131      ENDDO
132ENDIF
133!
134
135!IM ajout memes tests pour reverifier les jbad, jqbad beg
136      jbad=0
137      jqbad=0
138      DO k = 1, klev
139         DO i = 1, klon
140            IF ( t_seri(i,k)>370. .or. t_seri(i,k)<130. .or. abs(zdt(i,k))>50. ) then
141            jbad = jbad + 1
142            jadrs(jbad) = i
143!            if(prt_level.ge.debug_level) THEN
144!             print*,'cas2 i k t_seri zdt',i,k,t_seri(i,k),zdt(i,k)
145!            endif
146            ENDIF
147            IF ( q_seri(i,k)<0. .or. q_seri(i,k)>0.1 .or. abs(zdq(i,k))>1.e-2 ) then
148            jqbad = jqbad + 1
149            jqadrs(jqbad) = i
150            kqadrs(jqbad) = k
151!            if(prt_level.ge.debug_level) THEN
152!             print*,'cas2 i k q_seri zdq',i,k,q_seri(i,k),zdq(i,k)
153!            endif
154            ENDIF
155         ENDDO
156      ENDDO
157IF (jbad .GT. 0) THEN
158      DO j = 1, jbad
159         i=jadrs(j)
160         k=kadrs(j)
161         if(prt_level.ge.debug_level) THEN
162          print*,'PLANTAGE2 POUR LE POINT i itap rlon rlat txt jbad zdt t',i,itap,rlon(i),rlat(i),text,jbad, &
163       &        zdt(i,k),t_seri(i,k)-zdt(i,k)
164!!!       if(prt_level.ge.10.and.itap.GE.229.and.i.EQ.3027) THEN
165          print*,'l    T     dT       Q     dQ    '
166          DO k = 1, klev
167             write(*,'(i3,2f14.4,2e14.2)') k,t_seri(i,k),zdt(i,k),q_seri(i,k),zdq(i,k)
168          ENDDO
169          call print_debug_phys(i,debug_level,text)
170         endif
171      ENDDO
172ENDIF
173!
174IF (jqbad .GT. 0) THEN
175      DO j = 1, jqbad
176         i=jqadrs(j)
177         k=kqadrs(j)
178         if(prt_level.ge.debug_level) THEN
179          print*,'WARNING  : EAU2 POUR LE POINT i itap rlon rlat txt jqbad zdq q zdql ql',i,itap,rlon(i),rlat(i),text,jqbad,&
180       &        zdq(i,k), q_seri(i,k)-zdq(i,k), zdql(i,k), ql_seri(i,k)-zdql(i,k)
181!!!       if(prt_level.ge.10.and.itap.GE.229.and.i.EQ.3027) THEN
182          print*,'l    T     dT       Q     dQ    '
183          DO k = 1, klev
184            write(*,'(i3,2f14.4,2e14.2)') k,t_seri(i,k),zdt(i,k),q_seri(i,k),zdq(i,k)
185          ENDDO
186          call print_debug_phys(i,debug_level,text)
187         endif
188      ENDDO
189ENDIF
190
191      CALL hgardfou(t_seri,ftsol,text)
192      RETURN
193      END
Note: See TracBrowser for help on using the repository browser.