Context Navigation

alpale_th.F90 @ 2517

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

Rev	Line
[2513]	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)
[2515]	53	first=.FALSE.
[2513]	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