Context Navigation

calwake.F90 @ 2146

Last change on this file since 2146 was 1992, checked in by lguez, 11 years ago

Converted to free source form files in libf/phylmd which were still in
fixed source form. The conversion was done using the polish mode of
the NAG Fortran Compiler.

In addition to converting to free source form, the processing of the
files also:

-- indented the code (including comments);

-- set Fortran keywords to uppercase, and set all other identifiers
to lower case;

-- added qualifiers to end statements (for example "end subroutine
conflx", instead of "end");

-- changed the terminating statements of all DO loops so that each
loop ends with an ENDDO statement (instead of a labeled continue).

-- replaced #include by include.

Property copyright set to
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory
Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 12.8 KB

Rev	Line
[1992]	1
[1403]	2	! $Id: calwake.F90 1992 2014-03-05 13:19:12Z idelkadi $
[879]	3
[1992]	4	SUBROUTINE calwake(paprs, pplay, dtime, t, q, omgb, dt_dwn, dq_dwn, m_dwn, &
	5	m_up, dt_a, dq_a, sigd, wdt_pbl, wdq_pbl, udt_pbl, udq_pbl, wake_deltat, &
	6	wake_deltaq, wake_dth, wake_h, wake_s, wake_dens, wake_pe, wake_fip, &
	7	wake_gfl, dt_wake, dq_wake, wake_k, undi_t, undi_q, wake_omgbdth, &
	8	wake_dp_omgb, wake_dtke, wake_dqke, wake_dtpbl, wake_dqpbl, wake_omg, &
	9	wake_dp_deltomg, wake_spread, wake_cstar, wake_d_deltat_gw, wake_ddeltat, &
	10	wake_ddeltaq)
	11	! **************************************************************
	12	! *
	13	! CALWAKE *
	14	! interface avec le schema de calcul de la poche *
	15	! froide *
	16	! *
	17	! written by : CHERUY Frederique, 13/03/2000, 10.31.05 *
	18	! modified by : ROEHRIG Romain, 01/30/2007 *
	19	! **************************************************************
[974]	20
[1992]	21	USE dimphy
	22	IMPLICIT NONE
	23	! ======================================================================
	24	include "dimensions.h"
	25	! #include "dimphy.h"
	26	include "YOMCST.h"
[974]	27
[1992]	28	! Arguments
	29	! ----------
[974]	30
[1992]	31	INTEGER i, l, ktopw(klon)
	32	REAL dtime
[974]	33
[1992]	34	REAL paprs(klon, klev+1), pplay(klon, klev)
	35	REAL t(klon, klev), q(klon, klev), omgb(klon, klev)
	36	REAL dt_dwn(klon, klev), dq_dwn(klon, klev), m_dwn(klon, klev)
	37	REAL m_up(klon, klev)
	38	REAL dt_a(klon, klev), dq_a(klon, klev)
	39	REAL wdt_pbl(klon, klev), wdq_pbl(klon, klev)
	40	REAL udt_pbl(klon, klev), udq_pbl(klon, klev)
	41	REAL wake_deltat(klon, klev), wake_deltaq(klon, klev)
	42	REAL dt_wake(klon, klev), dq_wake(klon, klev)
	43	REAL wake_d_deltat_gw(klon, klev)
	44	REAL wake_h(klon), wake_s(klon)
	45	REAL wake_dth(klon, klev)
	46	REAL wake_pe(klon), wake_fip(klon), wake_gfl(klon)
	47	REAL undi_t(klon, klev), undi_q(klon, klev)
	48	REAL wake_omgbdth(klon, klev), wake_dp_omgb(klon, klev)
	49	REAL wake_dtke(klon, klev), wake_dqke(klon, klev)
	50	REAL wake_dtpbl(klon, klev), wake_dqpbl(klon, klev)
	51	REAL wake_omg(klon, klev), wake_dp_deltomg(klon, klev)
	52	REAL wake_spread(klon, klev), wake_cstar(klon)
	53	REAL wake_ddeltat(klon, klev), wake_ddeltaq(klon, klev)
	54	REAL d_deltatw(klon, klev), d_deltaqw(klon, klev)
	55	INTEGER wake_k(klon)
	56	REAL sigd(klon)
	57	REAL wake_dens(klon)
[974]	58
[1992]	59	! Variable internes
	60	! -----------------
[974]	61
[1992]	62	REAL aire
	63	REAL p(klon, klev), ph(klon, klev+1), pi(klon, klev)
	64	REAL te(klon, klev), qe(klon, klev), omgbe(klon, klev+1)
	65	REAL dtdwn(klon, klev), dqdwn(klon, klev)
	66	REAL dta(klon, klev), dqa(klon, klev)
	67	REAL wdtpbl(klon, klev), wdqpbl(klon, klev)
	68	REAL udtpbl(klon, klev), udqpbl(klon, klev)
	69	REAL amdwn(klon, klev), amup(klon, klev)
	70	REAL dtw(klon, klev), dqw(klon, klev), dth(klon, klev)
	71	REAL d_deltat_gw(klon, klev)
	72	REAL dtls(klon, klev), dqls(klon, klev)
	73	REAL tu(klon, klev), qu(klon, klev)
	74	REAL hw(klon), sigmaw(klon), wape(klon), fip(klon), gfl(klon)
	75	REAL omgbdth(klon, klev+1), dp_omgb(klon, klev)
	76	REAL dtke(klon, klev), dqke(klon, klev)
	77	REAL dtpbl(klon, klev), dqpbl(klon, klev)
	78	REAL omg(klon, klev+1), dp_deltomg(klon, klev), spread(klon, klev)
	79	REAL cstar(klon)
	80	REAL sigd0(klon), wdens(klon)
[974]	81
[1992]	82	REAL rdcp
[974]	83
[1992]	84	! print *, '-> calwake, wake_s ', wake_s(1)
[990]	85
[1992]	86	rdcp = 1./3.5
[974]	87
	88
[1992]	89	! -----------------------------------------------------------
	90	! IM 290108 DO 999 i=1,klon ! a vectoriser
	91	! ----------------------------------------------------------
[974]	92
	93
[1992]	94	DO l = 1, klev
	95	DO i = 1, klon
	96	p(i, l) = pplay(i, l)
	97	ph(i, l) = paprs(i, l)
	98	pi(i, l) = (pplay(i,l)/100000.)**rdcp
[990]	99
[1992]	100	te(i, l) = t(i, l)
	101	qe(i, l) = q(i, l)
	102	omgbe(i, l) = omgb(i, l)
[974]	103
[1992]	104	dtdwn(i, l) = dt_dwn(i, l)
	105	dqdwn(i, l) = dq_dwn(i, l)
	106	dta(i, l) = dt_a(i, l)
	107	dqa(i, l) = dq_a(i, l)
	108	wdtpbl(i, l) = wdt_pbl(i, l)
	109	wdqpbl(i, l) = wdq_pbl(i, l)
	110	udtpbl(i, l) = udt_pbl(i, l)
	111	udqpbl(i, l) = udq_pbl(i, l)
	112	END DO
	113	END DO
[974]	114
[1992]	115	omgbe(:, klev+1) = 0.
[974]	116
[1992]	117	DO i = 1, klon
	118	sigd0(i) = sigd(i)
	119	END DO
	120	! print*, 'sigd0,sigd', sigd0, sigd(i)
	121	DO i = 1, klon
	122	ph(i, klev+1) = 0.
	123	END DO
[974]	124
[1992]	125	DO i = 1, klon
	126	ktopw(i) = wake_k(i)
	127	END DO
[974]	128
[1992]	129	DO l = 1, klev
	130	DO i = 1, klon
	131	dtw(i, l) = wake_deltat(i, l)
	132	dqw(i, l) = wake_deltaq(i, l)
	133	END DO
	134	END DO
[974]	135
[1992]	136	DO l = 1, klev
	137	DO i = 1, klon
	138	dtls(i, l) = dt_wake(i, l)
	139	dqls(i, l) = dq_wake(i, l)
	140	END DO
	141	END DO
[974]	142
[1992]	143	DO i = 1, klon
	144	hw(i) = wake_h(i)
	145	sigmaw(i) = wake_s(i)
	146	END DO
[974]	147
[1992]	148	! fkc les flux de masses sont evalues aux niveaux et valent 0 a la surface
	149	! fkc on veut le flux de masse au milieu des couches
[974]	150
[1992]	151	DO l = 1, klev - 1
	152	DO i = 1, klon
	153	amdwn(i, l) = 0.5*(m_dwn(i,l)+m_dwn(i,l+1))
	154	amdwn(i, l) = (m_dwn(i,l+1))
	155	END DO
	156	END DO
[1403]	157
[1992]	158	! au sommet le flux de masse est nul
[974]	159
[1992]	160	DO i = 1, klon
	161	amdwn(i, klev) = 0.5*m_dwn(i, klev)
	162	END DO
[879]	163
[1992]	164	DO l = 1, klev
	165	DO i = 1, klon
	166	amup(i, l) = m_up(i, l)
	167	END DO
	168	END DO
[879]	169
[1992]	170	CALL wake(p, ph, pi, dtime, sigd0, te, qe, omgbe, dtdwn, dqdwn, amdwn, &
	171	amup, dta, dqa, wdtpbl, wdqpbl, udtpbl, udqpbl, dtw, dqw, dth, hw, &
	172	sigmaw, wape, fip, gfl, dtls, dqls, ktopw, omgbdth, dp_omgb, wdens, tu, &
	173	qu, dtke, dqke, dtpbl, dqpbl, omg, dp_deltomg, spread, cstar, &
	174	d_deltat_gw, d_deltatw, d_deltaqw)
[879]	175
[1992]	176	DO l = 1, klev
	177	DO i = 1, klon
	178	IF (ktopw(i)>0) THEN
	179	wake_deltat(i, l) = dtw(i, l)
	180	wake_deltaq(i, l) = dqw(i, l)
	181	wake_d_deltat_gw(i, l) = d_deltat_gw(i, l)
	182	wake_omgbdth(i, l) = omgbdth(i, l)
	183	wake_dp_omgb(i, l) = dp_omgb(i, l)
	184	wake_dtke(i, l) = dtke(i, l)
	185	wake_dqke(i, l) = dqke(i, l)
	186	wake_dtpbl(i, l) = dtpbl(i, l)
	187	wake_dqpbl(i, l) = dqpbl(i, l)
	188	wake_omg(i, l) = omg(i, l)
	189	wake_dp_deltomg(i, l) = dp_deltomg(i, l)
	190	wake_spread(i, l) = spread(i, l)
	191	wake_dth(i, l) = dth(i, l)
	192	dt_wake(i, l) = dtls(i, l)
	193	dq_wake(i, l) = dqls(i, l)
	194	undi_t(i, l) = tu(i, l)
	195	undi_q(i, l) = qu(i, l)
	196	wake_ddeltat(i, l) = d_deltatw(i, l)
	197	wake_ddeltaq(i, l) = d_deltaqw(i, l)
	198	ELSE
	199	wake_deltat(i, l) = 0.
	200	wake_deltaq(i, l) = 0.
	201	wake_d_deltat_gw(i, l) = 0.
	202	wake_omgbdth(i, l) = 0.
	203	wake_dp_omgb(i, l) = 0.
	204	wake_dtke(i, l) = 0.
	205	wake_dqke(i, l) = 0.
	206	wake_dtpbl(i, l) = 0.
	207	wake_dqpbl(i, l) = 0.
	208	wake_omg(i, l) = 0.
	209	wake_dp_deltomg(i, l) = 0.
	210	wake_spread(i, l) = 0.
	211	wake_dth(i, l) = 0.
	212	dt_wake(i, l) = 0.
	213	dq_wake(i, l) = 0.
	214	undi_t(i, l) = te(i, l)
	215	undi_q(i, l) = qe(i, l)
	216	wake_ddeltat(i, l) = 0.
	217	wake_ddeltaq(i, l) = 0.
	218	END IF
	219	END DO
	220	END DO
[879]	221
[1992]	222	DO i = 1, klon
	223	wake_h(i) = hw(i)
	224	wake_s(i) = sigmaw(i)
	225	wake_pe(i) = wape(i)
	226	wake_fip(i) = fip(i)
	227	wake_gfl(i) = gfl(i)
	228	wake_k(i) = ktopw(i)
	229	wake_cstar(i) = cstar(i)
	230	wake_dens(i) = wdens(i)
	231	END DO
[879]	232
[1992]	233	RETURN
	234	END SUBROUTINE calwake
[879]	235
[1992]	236	SUBROUTINE calwake_scal(paprs, pplay, dtime, t, q, omgb, dt_dwn, dq_dwn, &
	237	m_dwn, m_up, dt_a, dq_a, sigd, wdt_pbl, wdq_pbl, udt_pbl, udq_pbl, &
	238	wake_deltat, wake_deltaq, wake_dth, wake_h, wake_s, wake_dens, wake_pe, &
	239	wake_fip, wake_gfl, dt_wake, dq_wake, wake_k, undi_t, undi_q, &
	240	wake_omgbdth, wake_dp_omgb, wake_dtke, wake_dqke, wake_dtpbl, wake_dqpbl, &
	241	wake_omg, wake_dp_deltomg, wake_spread, wake_cstar, wake_d_deltat_gw, &
	242	wake_ddeltat, wake_ddeltaq)
	243	! **************************************************************
	244	! *
	245	! CALWAKE *
	246	! interface avec le schema de calcul de la poche *
	247	! froide *
	248	! *
	249	! written by : CHERUY Frederique, 13/03/2000, 10.31.05 *
	250	! modified by : ROEHRIG Romain, 01/30/2007 *
	251	! **************************************************************
[879]	252
[1992]	253	USE dimphy
	254	IMPLICIT NONE
	255	! ======================================================================
[879]	256
[1992]	257	include "dimensions.h"
	258	! ccc#include "dimphy.h"
	259	include "YOMCST.h"
[879]	260
[1992]	261	! Arguments
	262	! ----------
[879]	263
[1992]	264	INTEGER i, l, ktopw
	265	REAL dtime
[879]	266
[1992]	267	REAL paprs(klon, klev+1), pplay(klon, klev)
	268	REAL t(klon, klev), q(klon, klev), omgb(klon, klev)
	269	REAL dt_dwn(klon, klev), dq_dwn(klon, klev), m_dwn(klon, klev)
	270	REAL m_up(klon, klev)
	271	REAL dt_a(klon, klev), dq_a(klon, klev)
	272	REAL wdt_pbl(klon, klev), wdq_pbl(klon, klev)
	273	REAL udt_pbl(klon, klev), udq_pbl(klon, klev)
	274	REAL wake_deltat(klon, klev), wake_deltaq(klon, klev)
	275	REAL dt_wake(klon, klev), dq_wake(klon, klev)
	276	REAL wake_d_deltat_gw(klon, klev)
	277	REAL wake_h(klon), wake_s(klon)
	278	REAL wake_dth(klon, klev)
	279	REAL wake_pe(klon), wake_fip(klon), wake_gfl(klon)
	280	REAL undi_t(klon, klev), undi_q(klon, klev)
	281	REAL wake_omgbdth(klon, klev), wake_dp_omgb(klon, klev)
	282	REAL wake_dtke(klon, klev), wake_dqke(klon, klev)
	283	REAL wake_dtpbl(klon, klev), wake_dqpbl(klon, klev)
	284	REAL wake_omg(klon, klev+1), wake_dp_deltomg(klon, klev)
	285	REAL wake_spread(klon, klev), wake_cstar(klon)
	286	REAL wake_ddeltat(klon, klev), wake_ddeltaq(klon, klev)
	287	REAL d_deltatw(klev), d_deltaqw(klev)
	288	INTEGER wake_k(klon)
	289	REAL sigd(klon)
	290	REAL wake_dens(klon)
[879]	291
[1992]	292	! Variable internes
	293	! -----------------
[879]	294
[1992]	295	REAL aire
	296	REAL p(klev), ph(klev+1), pi(klev)
	297	REAL te(klev), qe(klev), omgbe(klev), dtdwn(klev), dqdwn(klev)
	298	REAL dta(klev), dqa(klev)
	299	REAL wdtpbl(klev), wdqpbl(klev)
	300	REAL udtpbl(klev), udqpbl(klev)
	301	REAL amdwn(klev), amup(klev)
	302	REAL dtw(klev), dqw(klev), dth(klev), d_deltat_gw(klev)
	303	REAL dtls(klev), dqls(klev)
	304	REAL tu(klev), qu(klev)
	305	REAL hw, sigmaw, wape, fip, gfl
	306	REAL omgbdth(klev), dp_omgb(klev)
	307	REAL dtke(klev), dqke(klev)
	308	REAL dtpbl(klev), dqpbl(klev)
	309	REAL omg(klev+1), dp_deltomg(klev), spread(klev), cstar
	310	REAL sigd0, wdens
[879]	311
[1992]	312	REAL rdcp
[879]	313
[1992]	314	! print *, '-> calwake, wake_s ', wake_s(1)
[879]	315
[1992]	316	rdcp = 1./3.5
[879]	317
[1992]	318	! -----------------------------------------------------------
	319	DO i = 1, klon ! a vectoriser
	320	! ----------------------------------------------------------
[879]	321
	322
[1992]	323	DO l = 1, klev
	324	p(l) = pplay(i, l)
	325	ph(l) = paprs(i, l)
	326	pi(l) = (pplay(i,l)/100000.)**rdcp
[879]	327
[1992]	328	te(l) = t(i, l)
	329	qe(l) = q(i, l)
	330	omgbe(l) = omgb(i, l)
[879]	331
[1992]	332	dtdwn(l) = dt_dwn(i, l)
	333	dqdwn(l) = dq_dwn(i, l)
	334	dta(l) = dt_a(i, l)
	335	dqa(l) = dq_a(i, l)
	336	wdtpbl(l) = wdt_pbl(i, l)
	337	wdqpbl(l) = wdq_pbl(i, l)
	338	udtpbl(l) = udt_pbl(i, l)
	339	udqpbl(l) = udq_pbl(i, l)
	340	END DO
[879]	341
[1992]	342	sigd0 = sigd(i)
	343	! print*, 'sigd0,sigd', sigd0, sigd(i)
	344	ph(klev+1) = 0.
[879]	345
[1992]	346	ktopw = wake_k(i)
[879]	347
[1992]	348	DO l = 1, klev
	349	dtw(l) = wake_deltat(i, l)
	350	dqw(l) = wake_deltaq(i, l)
	351	END DO
	352
	353	DO l = 1, klev
	354	dtls(l) = dt_wake(i, l)
	355	dqls(l) = dq_wake(i, l)
	356	END DO
	357
	358	hw = wake_h(i)
	359	sigmaw = wake_s(i)
	360
	361	! fkc les flux de masses sont evalues aux niveaux et valent 0 a la
	362	! surface
	363	! fkc on veut le flux de masse au milieu des couches
	364
	365	DO l = 1, klev - 1
	366	amdwn(l) = 0.5*(m_dwn(i,l)+m_dwn(i,l+1))
	367	amdwn(l) = (m_dwn(i,l+1))
	368	END DO
	369
	370	! au sommet le flux de masse est nul
	371
	372	amdwn(klev) = 0.5*m_dwn(i, klev)
	373
	374	DO l = 1, klev
	375	amup(l) = m_up(i, l)
	376	END DO
	377
	378	CALL wake_scal(p, ph, pi, dtime, sigd0, te, qe, omgbe, dtdwn, dqdwn, &
	379	amdwn, amup, dta, dqa, wdtpbl, wdqpbl, udtpbl, udqpbl, dtw, dqw, dth, &
	380	hw, sigmaw, wape, fip, gfl, dtls, dqls, ktopw, omgbdth, dp_omgb, wdens, &
	381	tu, qu, dtke, dqke, dtpbl, dqpbl, omg, dp_deltomg, spread, cstar, &
	382	d_deltat_gw, d_deltatw, d_deltaqw)
	383
	384	IF (ktopw>0) THEN
	385	DO l = 1, klev
	386	wake_deltat(i, l) = dtw(l)
	387	wake_deltaq(i, l) = dqw(l)
	388	wake_d_deltat_gw(i, l) = d_deltat_gw(l)
	389	wake_omgbdth(i, l) = omgbdth(l)
	390	wake_dp_omgb(i, l) = dp_omgb(l)
	391	wake_dtke(i, l) = dtke(l)
	392	wake_dqke(i, l) = dqke(l)
	393	wake_dtpbl(i, l) = dtpbl(l)
	394	wake_dqpbl(i, l) = dqpbl(l)
	395	wake_omg(i, l) = omg(l)
	396	wake_dp_deltomg(i, l) = dp_deltomg(l)
	397	wake_spread(i, l) = spread(l)
	398	wake_dth(i, l) = dth(l)
	399	dt_wake(i, l) = dtls(l)
	400	dq_wake(i, l) = dqls(l)
	401	undi_t(i, l) = tu(l)
	402	undi_q(i, l) = qu(l)
	403	wake_ddeltat(i, l) = d_deltatw(l)
	404	wake_ddeltaq(i, l) = d_deltaqw(l)
	405	END DO
	406	ELSE
	407	DO l = 1, klev
	408	wake_deltat(i, l) = 0.
	409	wake_deltaq(i, l) = 0.
	410	wake_d_deltat_gw(i, l) = 0.
	411	wake_omgbdth(i, l) = 0.
	412	wake_dp_omgb(i, l) = 0.
	413	wake_dtke(i, l) = 0.
	414	wake_dqke(i, l) = 0.
	415	wake_omg(i, l) = 0.
	416	wake_dp_deltomg(i, l) = 0.
	417	wake_spread(i, l) = 0.
	418	wake_dth(i, l) = 0.
	419	dt_wake(i, l) = 0.
	420	dq_wake(i, l) = 0.
	421	undi_t(i, l) = te(l)
	422	undi_q(i, l) = qe(l)
	423	END DO
	424	END IF
	425
	426	wake_h(i) = hw
	427	wake_s(i) = sigmaw
	428	wake_pe(i) = wape
	429	wake_fip(i) = fip
	430	wake_gfl(i) = gfl
	431	wake_k(i) = ktopw
	432	wake_cstar(i) = cstar
	433	wake_dens(i) = wdens
	434
	435	END DO
	436
	437	RETURN
	438	END SUBROUTINE calwake_scal

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

Download in other formats:

Original Format