/[lmdze]/trunk/libf/phylmd/calltherm.f
ViewVC logotype

Contents of /trunk/libf/phylmd/calltherm.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3 - (show annotations)
Wed Feb 27 13:16:39 2008 UTC (16 years, 2 months ago) by guez
File size: 3706 byte(s)
Initial import
1 !
2 ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/calltherm.F,v 1.2 2004/12/10 11:27:46 lmdzadmin Exp $
3 !
4 subroutine calltherm(dtime
5 s ,pplay,paprs,pphi
6 s ,u_seri,v_seri,t_seri,q_seri
7 s ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs
8 s ,fm_therm,entr_therm)
9
10 use dimens_m
11 use dimphy
12 use ctherm
13 implicit none
14
15 REAL dtime
16
17 REAL u_seri(klon,klev),v_seri(klon,klev)
18 REAL t_seri(klon,klev),q_seri(klon,klev)
19 REAL, intent(in):: paprs(klon,klev+1)
20 REAL pplay(klon,klev)
21 REAL pphi(klon,klev)
22
23 CFH Update Thermiques
24 REAL d_t_ajs(klon,klev), d_q_ajs(klon,klev)
25 REAL d_u_ajs(klon,klev),d_v_ajs(klon,klev)
26 real fm_therm(klon,klev+1),entr_therm(klon,klev)
27
28
29 c variables locales
30 REAL d_t_the(klon,klev), d_q_the(klon,klev)
31 REAL d_u_the(klon,klev),d_v_the(klon,klev)
32 c
33 real zfm_therm(klon,klev+1),zentr_therm(klon,klev),zdt
34 save zentr_therm,zfm_therm
35
36 integer i,k, isplit
37
38 *********************************************************
39
40 c Modele du thermique
41 c ===================
42 c print*,'thermiques: WARNING on passe t au lieu de t_seri'
43 print*,'avant isplit ',nsplit_thermals
44
45
46 fm_therm(:,:)=0.
47 entr_therm(:,:)=0.
48
49 c tests sur les valeurs negatives de l'eau
50 do k=1,klev
51 do i=1,klon
52 if (.not.q_seri(i,k).ge.0.) then
53 print*,'WARN eau<0 avant therm i=',i,' k=',k
54 s ,' dq,q',d_q_the(i,k),q_seri(i,k)
55 q_seri(i,k)=1.e-15
56 endif
57 enddo
58 enddo
59
60
61 zdt=dtime/float(nsplit_thermals)
62 do isplit=1,nsplit_thermals
63
64 cym CALL thermcell(klon,klev,zdt
65 cym s ,pplay,paprs,pphi
66 cym s ,u_seri,v_seri,t_seri,q_seri
67 cym s ,d_u_the,d_v_the,d_t_the,d_q_the
68 cym s ,zfm_therm,zentr_therm
69 cym s ,r_aspect_thermals,l_mix_thermals,w2di_thermals
70 cym s ,tho_thermals,3)
71
72 CALL thermcell(klon,klev,zdt
73 s ,pplay,paprs,pphi
74 s ,u_seri,v_seri,t_seri,q_seri
75 s ,d_u_the,d_v_the,d_t_the,d_q_the
76 s ,zfm_therm,zentr_therm
77 s ,r_aspect_thermals,l_mix_thermals,w2di_thermals
78 s ,tho_thermals)
79
80 c transformation de la derivee en tendance
81 d_t_the(:,:)=d_t_the(:,:)*dtime/float(nsplit_thermals)
82 d_u_the(:,:)=d_u_the(:,:)*dtime/float(nsplit_thermals)
83 d_v_the(:,:)=d_v_the(:,:)*dtime/float(nsplit_thermals)
84 d_q_the(:,:)=d_q_the(:,:)*dtime/float(nsplit_thermals)
85 fm_therm(:,:)=fm_therm(:,:)
86 s +zfm_therm(:,:)/float(nsplit_thermals)
87 entr_therm(:,:)=entr_therm(:,:)
88 s +zentr_therm(:,:)/float(nsplit_thermals)
89 fm_therm(:,klev+1)=0.
90
91
92
93 c accumulation de la tendance
94 d_t_ajs(:,:)=d_t_ajs(:,:)+d_t_the(:,:)
95 d_u_ajs(:,:)=d_u_ajs(:,:)+d_u_the(:,:)
96 d_v_ajs(:,:)=d_v_ajs(:,:)+d_v_the(:,:)
97 d_q_ajs(:,:)=d_q_ajs(:,:)+d_q_the(:,:)
98
99 c incrementation des variables meteo
100 t_seri(:,:) = t_seri(:,:) + d_t_the(:,:)
101 u_seri(:,:) = u_seri(:,:) + d_u_the(:,:)
102 v_seri(:,:) = v_seri(:,:) + d_v_the(:,:)
103 q_seri(:,:) = q_seri(:,:) + d_q_the(:,:)
104
105 c tests sur les valeurs negatives de l'eau
106 DO k = 1, klev
107 DO i = 1, klon
108 if (.not.q_seri(i,k).ge.0.) then
109 print*,'WARN eau<0 apres therm i=',i,' k=',k
110 s ,' dq,q',d_q_the(i,k),q_seri(i,k)
111 q_seri(i,k)=1.e-15
112 endif
113 ENDDO
114 ENDDO
115
116 enddo ! isplit
117
118 return
119
120 end

  ViewVC Help
Powered by ViewVC 1.1.21