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

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

Print commentés pour plus d'efficacité
YM/LF
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 6.2 KB
RevLine 
[904]1!
[1163]2! $Id: add_phys_tend.F90 1163 2009-05-20 14:11:21Z asima $
[904]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
[941]18use phys_state_var_mod
[904]19IMPLICIT none
[972]20#include "iniprint.h"
[904]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
[924]33INTEGER jadrs(klon*klev), jbad
34INTEGER jqadrs(klon*klev), jqbad
[972]35INTEGER kadrs(klon*klev)
36INTEGER kqadrs(klon*klev)
[904]37
38integer debug_level
[972]39logical, save :: first=.true.
[987]40!$OMP THREADPRIVATE(first)
[972]41INTEGER, SAVE :: itap
[987]42!$OMP THREADPRIVATE(itap)
[904]43!======================================================================
44! Initialisations
45
46debug_level=10
[972]47     if (first) then
48        itap=0
49        first=.false.
50     endif
51! Incrementer le compteur de la physique
52     itap   = itap + 1
[904]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
[972]75            kadrs(jbad) = k
[904]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
[972]80            kqadrs(jqbad) = k
[904]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)
[1047]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
[904]98             write(*,'(i3,2f14.4,2e14.2)') k,t_seri(i,k),zdt(i,k),q_seri(i,k),zdq(i,k)
[1047]99          ENDDO
100          call print_debug_phys(i,debug_level,text)
101         endif
[904]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)
[1047]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
[904]115         DO k = 1, klev
[972]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
[1047]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
[972]122               q_seri(i,k)=1.e-15
123               zdq(i,k)=(1.e-15-q_seri(i,k))
124              endif
125           endif
[904]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
[972]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
[1163]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
[972]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
[1163]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
[972]154            ENDIF
155         ENDDO
156      ENDDO
157IF (jbad .GT. 0) THEN
158      DO j = 1, jbad
159         i=jadrs(j)
160         k=kadrs(j)
[1047]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, &
[972]163       &        zdt(i,k),t_seri(i,k)-zdt(i,k)
[1047]164!!!       if(prt_level.ge.10.and.itap.GE.229.and.i.EQ.3027) THEN
[972]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
[1163]172ENDIF
[972]173!
174IF (jqbad .GT. 0) THEN
175      DO j = 1, jqbad
176         i=jqadrs(j)
177         k=kqadrs(j)
[1047]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,&
[972]180       &        zdq(i,k), q_seri(i,k)-zdq(i,k), zdql(i,k), ql_seri(i,k)-zdql(i,k)
[1047]181!!!       if(prt_level.ge.10.and.itap.GE.229.and.i.EQ.3027) THEN
[972]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)
[904]192      RETURN
193      END
Note: See TracBrowser for help on using the repository browser.