Context Navigation

alpale_th.F90 @ 2518

Last change on this file since 2518 was 2515, checked in by jyg, 9 years ago
Bug fix to svn2513
File size: 6.6 KB

Line
1	SUBROUTINE alpale_th ( dtime, lmax_th, t_seri, &
2	cin, s2, n2, &
3	ale_bl_trig, ale_bl_stat, ale_bl, &
4	alp_bl, alp_bl_stat )
5
6	! **************************************************************
7	! *
8	! ALPALE_TH *
9	! *
10	! *
11	! written by : Jean-Yves Grandpeix, 11/05/2016 *
12	! modified by : *
13	! **************************************************************
14
15	USE dimphy
16	USE ioipsl_getin_p_mod, ONLY : getin_p
17	USE print_control_mod, ONLY: mydebug=>debug , lunout, prt_level
18	!
19	IMPLICIT NONE
20
21	!================================================================
22	! Auteur(s) : Jean-Yves Grandpeix, 11/05/2016
23	! Objet : Contribution of the thermal scheme to Ale and Alp
24	!================================================================
25
26	! Input arguments
27	!----------------
28	REAL, INTENT(IN) :: dtime
29	INTEGER, DIMENSION(klon), INTENT(IN) :: lmax_th
30	REAL, DIMENSION(klon,klev), INTENT(IN) :: t_seri
31	REAL, DIMENSION(klon), INTENT(IN) :: ale_bl_stat
32	REAL, DIMENSION(klon), INTENT(IN) :: cin
33	REAL, DIMENSION(klon), INTENT(IN) :: s2, n2
34
35	REAL, DIMENSION(klon), INTENT(INOUT) :: ale_bl_trig, ale_bl
36	REAL, DIMENSION(klon), INTENT(INOUT) :: alp_bl
37	REAL, DIMENSION(klon), INTENT(INOUT) :: alp_bl_stat
38
39	include "thermcell.h"
40
41	! Local variables
42	!----------------
43	INTEGER :: i
44	LOGICAL, SAVE :: first = .TRUE.
45	REAL, SAVE :: random_notrig_max=1.
46	REAL, DIMENSION(klon) :: proba_notrig, tau_trig, random_notrig
47	!
48	!$OMP THREADPRIVATE(random_notrig_max)
49	!$OMP THREADPRIVATE(first)
50	!
51	IF (first) THEN
52	CALL getin_p('random_notrig_max',random_notrig_max)
53	first=.FALSE.
54	ENDIF
55	!cc nrlmd le 10/04/2012
56	!-----------Stochastic triggering-----------
57	if (iflag_trig_bl.ge.1) then
58	!
59	IF (prt_level .GE. 10) THEN
60	print *,'cin, ale_bl_stat, alp_bl_stat ', &
61	cin, ale_bl_stat, alp_bl_stat
62	ENDIF
63
64
65	!----Initialisations
66	do i=1,klon
67	proba_notrig(i)=1.
68	random_notrig(i)=1e6ale_bl_stat(i)-int(1e6ale_bl_stat(i))
69	if ( random_notrig(i) > random_notrig_max ) random_notrig(i)=0.
70	if ( ale_bl_trig(i) .lt. abs(cin(i))+1.e-10 ) then
71	tau_trig(i)=tau_trig_shallow
72	else
73	tau_trig(i)=tau_trig_deep
74	endif
75	enddo
76	!
77	IF (prt_level .GE. 10) THEN
78	print *,'random_notrig, tau_trig ', &
79	random_notrig, tau_trig
80	print *,'s_trig,s2,n2 ', &
81	s_trig,s2,n2
82	ENDIF
83
84	!Option pour re-activer l'ancien calcul de Ale_bl (iflag_trig_bl=2)
85	IF (iflag_trig_bl.eq.1) then
86
87	!----Tirage al\'eatoire et calcul de ale_bl_trig
88	do i=1,klon
89	if ( (ale_bl_stat(i) .gt. abs(cin(i))+1.e-10) ) then
90	proba_notrig(i)=(1.-exp(-s_trig/s2(i)))** &
91	(n2(i)*dtime/tau_trig(i))
92	! print *, 'proba_notrig(i) ',proba_notrig(i)
93	if (random_notrig(i) .ge. proba_notrig(i)) then
94	ale_bl_trig(i)=ale_bl_stat(i)
95	else
96	ale_bl_trig(i)=0.
97	endif
98	else
99	proba_notrig(i)=1.
100	random_notrig(i)=0.
101	ale_bl_trig(i)=0.
102	endif
103	enddo
104
105	ELSE IF (iflag_trig_bl.ge.2) then
106
107	do i=1,klon
108	if ( (Ale_bl(i) .gt. abs(cin(i))+1.e-10) ) then
109	proba_notrig(i)=(1.-exp(-s_trig/s2(i)))** &
110	(n2(i)*dtime/tau_trig(i))
111	! print *, 'proba_notrig(i) ',proba_notrig(i)
112	if (random_notrig(i) .ge. proba_notrig(i)) then
113	ale_bl_trig(i)=Ale_bl(i)
114	else
115	ale_bl_trig(i)=0.
116	endif
117	else
118	proba_notrig(i)=1.
119	random_notrig(i)=0.
120	ale_bl_trig(i)=0.
121	endif
122	enddo
123
124	ENDIF
125
126	!
127	IF (prt_level .GE. 10) THEN
128	print *,'proba_notrig, ale_bl_trig ', &
129	proba_notrig, ale_bl_trig
130	ENDIF
131
132	endif !(iflag_trig_bl)
133
134	!-----------Statistical closure-----------
135	if (iflag_clos_bl.eq.1) then
136
137	do i=1,klon
138	!CR: alp probabiliste
139	if (ale_bl_trig(i).gt.0.) then
140	alp_bl(i)=alp_bl(i)/(1.-min(proba_notrig(i),0.999))
141	endif
142	enddo
143
144	else if (iflag_clos_bl.eq.2) then
145
146	!CR: alp calculee dans thermcell_main
147	do i=1,klon
148	alp_bl(i)=alp_bl_stat(i)
149	enddo
150
151	else
152
153	alp_bl_stat(:)=0.
154
155	endif !(iflag_clos_bl)
156
157	IF (prt_level .GE. 10) THEN
158	print *,'ale_bl_trig, alp_bl_stat ',ale_bl_trig, alp_bl_stat
159	ENDIF
160
161	!cc fin nrlmd le 10/04/2012
162
163	! ------------------------------------------------------------------
164	! Transport de la TKE par les panaches thermiques.
165	! FH : 2010/02/01
166	! if (iflag_pbl.eq.10) then
167	! call thermcell_dtke(klon,klev,nbsrf,pdtphys,fm_therm,entr_therm,
168	! s rg,paprs,pbl_tke)
169	! endif
170	! -------------------------------------------------------------------
171	!IM/FH: 2011/02/23
172	! Couplage Thermiques/Emanuel seulement si T<0
173	if (iflag_coupl==2) then
174	IF (prt_level .GE. 10) THEN
175	print*,'Couplage Thermiques/Emanuel seulement si T<0'
176	ENDIF
177	do i=1,klon
178	if (t_seri(i,lmax_th(i))>273.) then
179	Ale_bl(i)=0.
180	endif
181	enddo
182	endif
183	!
184	RETURN
185	END
186

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format