Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

alpale_mod.f90 @ 5300

Last change on this file since 5300 was 5284, checked in by abarral, 5 weeks ago
Turn alpale.h alpale.f90 YOETHF.h into modules
File size: 8.0 KB

Rev	Line
[5284]	1	! Contains the alpale subroutine, as well as the old content from alpale.h
[2513]	2
[5284]	3	MODULE alpale_mod
	4	IMPLICIT NONE; PRIVATE
	5	PUBLIC alpale
[2513]	6
[5284]	7	!=====================================================================
	8	! Specifique de Ale/Alp :
	9	!=====================================================================
	10	PUBLIC iflag_trig_bl, iflag_clos_bl, tau_trig_shallow, tau_trig_deep, iflag_strig, &
	11	alp_bl_k, s_trig, h_trig, iflag_coupl, iflag_clos, iflag_wake
	12	! dans alealp_th, thermcell_alp, physiq_mod, conf_phys
	13	INTEGER :: iflag_trig_bl, iflag_clos_bl, iflag_strig
	14	INTEGER :: tau_trig_shallow, tau_trig_deep
	15	REAL :: s_trig, h_trig
	16	! thermcell_alp et convection ...
	17	INTEGER :: iflag_coupl, iflag_clos, iflag_wake
	18	! thermcell_alp
	19	REAL :: alp_bl_k
	20	!$OMP THREADPRIVATE(iflag_trig_bl, iflag_clos_bl, tau_trig_shallow, tau_trig_deep, iflag_strig)
	21	!$OMP THREADPRIVATE(alp_bl_k, s_trig, h_trig, iflag_coupl, iflag_clos, iflag_wake)
[2513]	22
[5284]	23	CONTAINS
[2513]	24
[5284]	25	SUBROUTINE alpale(debut, itap, dtime, paprs, omega, t_seri, &
	26	alp_offset, it_wape_prescr, wape_prescr, fip_prescr, &
	27	ale_bl_prescr, alp_bl_prescr, &
	28	wake_pe, wake_fip, &
	29	Ale_bl, Ale_bl_trig, Alp_bl, &
	30	Ale, Alp, Ale_wake, Alp_wake)
[2513]	31
[5284]	32	! **************************************************************
	33	! *
	34	! ALPALE *
	35	! *
	36	! *
	37	! written by : Jean-Yves Grandpeix, 12/05/2016 *
	38	! modified by : *
	39	! **************************************************************
[2513]	40
[5284]	41	USE dimphy
	42	USE ioipsl_getin_p_mod, ONLY: getin_p
	43	USE print_control_mod, ONLY: mydebug => debug, lunout, prt_level
	44	USE phys_local_var_mod, ONLY: zw2 ! Variables internes non sauvegardees de la physique
	45	USE yoethf_mod_h
	46	USE yomcst_mod_h
[2513]	47
[5284]	48	IMPLICIT NONE
[5274]	49
[5284]	50	!================================================================
	51	! Auteur(s) : Jean-Yves Grandpeix, 12/05/2016
	52	! Objet : Sums up all contributions to Ale and Alp
	53	!================================================================
[2513]	54
[5284]	55	! Input arguments
	56	!----------------
	57	LOGICAL, INTENT(IN) :: debut
	58	INTEGER, INTENT(IN) :: itap
	59	REAL, INTENT(IN) :: dtime
	60	INTEGER, INTENT(IN) :: it_wape_prescr
	61	REAL, INTENT(IN) :: wape_prescr, fip_prescr
	62	REAL, INTENT(IN) :: Ale_bl_prescr, Alp_bl_prescr
	63	REAL, INTENT(IN) :: alp_offset
	64	REAL, DIMENSION(klon, klev + 1), INTENT(IN) :: paprs
	65	REAL, DIMENSION(klon, klev), INTENT(IN) :: t_seri
	66	REAL, DIMENSION(klon, klev), INTENT(IN) :: omega
	67	REAL, DIMENSION(klon), INTENT(IN) :: wake_pe, wake_fip
	68	REAL, DIMENSION(klon), INTENT(IN) :: Ale_bl, Ale_bl_trig, Alp_bl
[2513]	69
	70
[5284]	71	! Output arguments
	72	!----------------
	73	REAL, DIMENSION(klon), INTENT(OUT) :: Ale, Alp
	74	REAL, DIMENSION(klon), INTENT(OUT) :: Ale_wake, Alp_wake
	75
	76	! Local variables
	77	!----------------
	78	INTEGER :: i, k
	79	REAL, DIMENSION(klon) :: www
	80	REAL, SAVE :: ale_max = 1000.
	81	REAL, SAVE :: alp_max = 2.
	82	CHARACTER*20 modname
	83	CHARACTER*80 abort_message
	84
	85
[2513]	86	!$OMP THREADPRIVATE(ale_max,alp_max)
	87
[5284]	88	! Calcul de l'energie disponible ALE (J/kg) et de la puissance
	89	! disponible ALP (W/m2) pour le soulevement des particules dans
	90	! le modele convectif
[2513]	91
[5284]	92	DO i = 1, klon
	93	ALE(i) = 0.
	94	ALP(i) = 0.
	95	enddo
[2513]	96
[5284]	97	!calcul de ale_wake et alp_wake
	98	IF (iflag_wake>=1) THEN
	99	IF (itap <= it_wape_prescr) THEN
	100	DO i = 1, klon
	101	ale_wake(i) = wape_prescr
	102	alp_wake(i) = fip_prescr
	103	enddo
	104	else
	105	DO i = 1, klon
	106	!jyg ALE=WAPE au lieu de ALE = 1/2 Cstar**2
	107	!cc ale_wake(i) = 0.5wake_cstar(i)*2
	108	ale_wake(i) = wake_pe(i)
	109	alp_wake(i) = wake_fip(i)
	110	enddo
	111	endif
	112	else
	113	DO i = 1, klon
	114	ale_wake(i) = 0.
	115	alp_wake(i) = 0.
	116	enddo
	117	endif
	118	!combinaison avec ale et alp de couche limite: constantes si pas
	119	!de couplage, valeurs calculees dans le thermique sinon
	120	IF (iflag_coupl==0) THEN
	121	IF (debut.AND.prt_level>9) &
	122	WRITE(lunout, *)'ALE et ALP imposes'
	123	DO i = 1, klon
	124	!on ne couple que ale
	125	! ALE(i) = max(ale_wake(i),Ale_bl(i))
	126	ALE(i) = max(ale_wake(i), ale_bl_prescr)
	127	!on ne couple que alp
	128	! ALP(i) = alp_wake(i) + Alp_bl(i)
	129	ALP(i) = alp_wake(i) + alp_bl_prescr
	130	enddo
	131	else
	132	IF(prt_level>9)WRITE(lunout, *)'ALE et ALP couples au thermique'
	133	! do i = 1,klon
	134	! ALE(i) = max(ale_wake(i),Ale_bl(i))
	135	! avant ALP(i) = alp_wake(i) + Alp_bl(i)
	136	! ALP(i) = alp_wake(i) + Alp_bl(i) + alp_offset ! modif sb
	137	! WRITE(20,*)'ALE',ALE(i),Ale_bl(i),ale_wake(i)
	138	! WRITE(21,*)'ALP',ALP(i),Alp_bl(i),alp_wake(i)
	139	! enddo
[2513]	140
[5284]	141	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	142	! Modif FH 2010/04/27. Sans doute temporaire.
	143	! Deux options pour le alp_offset : constant si >?? 0 ou
	144	! proportionnel ??a w si <0
	145	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	146	! Estimation d'une vitesse verticale effective pour ALP
	147	IF (1==0) THEN
	148	www(1:klon) = 0.
	149	DO k = 2, klev - 1
	150	DO i = 1, klon
	151	www(i) = max(www(i), -omega(i, k) * RD * t_seri(i, k) &
	152	/ (RG * paprs(i, k)) * zw2(i, k) * zw2(i, k))
	153	! if (paprs(i,k)>pbase(i)) THEN
	154	! calcul approche de la vitesse verticale en m/s
	155	! www(i)=max(www(i),-omega(i,k)RDtemp(i,k)/(RG*paprs(i,k))
	156	! endif
	157	! Le 0.1 est en gros H / ps = 1e4 / 1e5
[2513]	158	enddo
[5284]	159	enddo
	160	DO i = 1, klon
	161	IF (www(i)>0. .AND. ale_bl(i)>0.) www(i) = www(i) / ale_bl(i)
	162	enddo
	163	ENDIF
[2513]	164
[5284]	165	DO i = 1, klon
	166	ALE(i) = max(ale_wake(i), Ale_bl(i))
	167	!cc nrlmd le 10/04/2012----------Stochastic triggering------------
	168	IF (iflag_trig_bl>=1) THEN
	169	ALE(i) = max(ale_wake(i), Ale_bl_trig(i))
	170	endif
	171	!cc fin nrlmd le 10/04/2012
	172	IF (alp_offset>=0.) THEN
	173	ALP(i) = alp_wake(i) + Alp_bl(i) + alp_offset ! modif sb
	174	else
	175	abort_message = 'Ne pas passer la car www non calcule'
	176	CALL abort_physic (modname, abort_message, 1)
[2513]	177
[5284]	178	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	179	! _ _
	180	! Ajout d'une composante 3 * A * w w'2 a w'3 avec
	181	! w=www : w max sous pbase ou A est la fraction
	182	! couverte par les ascendances w' on utilise le fait
	183	! que A * w'3 = ALP et donc A * w'2 ~ ALP / sqrt(ALE)
	184	! (on ajoute 0.1 pour les singularites)
	185	ALP(i) = alp_wake(i) * (1. + 3. * www(i) / (sqrt(ale_wake(i)) + 0.1)) &
	186	+ alp_bl(i) * (1. + 3. * www(i) / (sqrt(ale_bl(i)) + 0.1))
	187	! ALP(i)=alp_wake(i)+Alp_bl(i)+alp_offset*min(omega(i,6),0.)
	188	! if (alp(i)<0.) THEN
	189	! PRINT*,'ALP ',alp(i),alp_wake(i) &
	190	! ,Alp_bl(i),alp_offset*min(omega(i,6),0.)
	191	! endif
	192	endif
	193	enddo
	194	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[2513]	195
[5284]	196	endif
	197	DO i = 1, klon
	198	IF (alp(i)>alp_max) THEN
	199	IF(prt_level>9)WRITE(lunout, *) &
	200	'WARNING SUPER ALP (seuil=', alp_max, &
	201	'): i, alp, alp_wake,ale', i, alp(i), alp_wake(i), ale(i)
	202	alp(i) = alp_max
	203	endif
	204	IF (ale(i)>ale_max) THEN
	205	IF(prt_level>9)WRITE(lunout, *) &
	206	'WARNING SUPER ALE (seuil=', ale_max, &
	207	'): i, alp, alp_wake,ale', i, ale(i), ale_wake(i), alp(i)
	208	ale(i) = ale_max
	209	endif
	210	enddo
[2513]	211
[5284]	212	!fin calcul ale et alp
	213	!=======================================================================
	214
	215	RETURN
[2513]	216	END
	217
[5284]	218	END MODULE alpale_mod

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

Download in other formats:

Original Format