My Project
 All Classes Files Functions Variables Macros
add_phys_tend.F90
Go to the documentation of this file.
1 !
2 ! $Id: add_phys_tend.F90 1163 2009-05-20 14:11:21Z fairhead $
3 !
4 SUBROUTINE 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 
16 use dimphy
17 use phys_local_var_mod
18 use phys_state_var_mod
19 IMPLICIT none
20 #include "iniprint.h"
21 
22 ! Arguments :
23 !------------
24 REAL zdu(klon,klev),zdv(klon,klev)
25 REAL zdt(klon,klev),zdq(klon,klev),zdql(klon,klev)
26 CHARACTER*(*) text
27 
28 ! Local :
29 !--------
30 REAL zt,zq
31 
32 INTEGER i, k,j
33 INTEGER jadrs(klon*klev), jbad
34 INTEGER jqadrs(klon*klev), jqbad
35 INTEGER kadrs(klon*klev)
36 INTEGER kqadrs(klon*klev)
37 
38 integer debug_level
39 logical, save :: first=.true.
40 !$OMP THREADPRIVATE(first)
41 INTEGER, SAVE :: itap
42 !$OMP THREADPRIVATE(itap)
43 !======================================================================
44 ! Initialisations
45 
46 debug_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 
91 IF (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
103 ENDIF
104 !
105 !=====================================================================================
106 ! Impression, warning et correction en cas de probleme moins important
107 !=====================================================================================
108 IF (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
132 ENDIF
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
157 IF (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
172 ENDIF
173 !
174 IF (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
189 ENDIF
190 
191  CALL hgardfou(t_seri,ftsol,text)
192  RETURN
193  END