Context Navigation

lwxb.F @ 2083

Last change on this file since 2083 was 1266, checked in by aslmd, 11 years ago

LMDZ.MARS
IMPORTANT CHANGE

Remove all reference/use of nlayermx and dimphys.h
Made use of automatic arrays whenever arrays are needed with dimension nlayer
Remove lots of obsolete reference to dimensions.h
Converted iono.h and param_v4.h into corresponding modules

(with embedded subroutine to allocate arrays)
(no arrays allocated if thermosphere not used)

Deleted param.h and put contents into module param_v4_h
Adapted testphys1d, newstart, etc...
Made DATA arrays in param_read to be initialized by subroutine

fill_data_thermos in module param_v4_h

Optimized computations in paramfoto_compact (twice less dlog10 calculations)
Checked consistency before/after modification in debug mode
Checked performance is not impacted (same as before)

File size: 7.5 KB

Rev	Line
[38]	1	subroutine lwxb (ig0,kdlon,kflev
	2	. ,emis
	3	. ,aer_t,co2_u,co2_up)
	4
	5	c----------------------------------------------------------------------
	6	c LWXB computes transmission function and exchange coefficients
	7	c for boundaries
	8	c (co2 / aerosols)
	9	c (bands 1 and 2 of co2)
	10	c----------------------------------------------------------------------
	11	c
	12	c \|---\|---\|---\|---\|---\|---\|---\|---\|
	13	c kflev+1 \|*\|\|\|\|\|\|**\| 0 \| (space)
	14	c \|---\|---\|---\|---\|---\|---\|---\|---\|
	15	c kflev \|*\| \| \| \| \| \| 0 \|*\|
	16	c \|---\|---\|---\|---\|---\|---\|---\|---\|
	17	c ... \|*\| \| \| \| \| 0 \| \|*\|
	18	c \|---\|---\|---\|---\|---\|---\|---\|---\|
	19	c 4 \|*\| \| \| \| 0 \| \| \|*\|
	20	c \|---\|---\|---\|---\|---\|---\|---\|---\|
	21	c 3 \|*\| \| \| 0 \| \| \| \|*\|
	22	c \|---\|---\|---\|---\|---\|---\|---\|---\|
	23	c 2 \|*\| \| 0 \| \| \| \| \|*\|
	24	c \|---\|---\|---\|---\|---\|---\|---\|---\|
	25	c 1 \|*\| 0 \| \| \| \| \| \|*\|
	26	c \|---\|---\|---\|---\|---\|---\|---\|---\|
	27	c 0 \| 0 \|*\|\|\|\|\|\|**\| (ground)
	28	c \|---\|---\|---\|---\|---\|---\|---\|---\|
	29	c 0 1 2 3 4 ... k \|k+1
	30	c (ground) (space)
	31	c
	32	c (*) xi computed in this subroutine
	33	c----------------------------------------------------------------------
	34
[1047]	35	use dimradmars_mod, only: ndlo2, nuco2, ndlon, nflev
	36	use yomlw_h, only: xi, nlaylte
[38]	37	implicit none
	38
	39	c----------------------------------------------------------------------
	40	c 0.1 arguments
	41	c ---------
	42	c inputs:
	43	c -------
	44	integer kdlon ! part of ngrid
	45	integer kflev ! part of nalyer
	46
	47	real emis (ndlo2) ! surface emissivity
	48	real aer_t (ndlo2,nuco2,kflev+1) ! transmission (aer)
	49	real co2_u (ndlo2,nuco2,kflev+1) ! absorber amounts (co2)
	50	real co2_up (ndlo2,nuco2,kflev+1) ! idem scaled by the pressure (co2)
	51
	52	c----------------------------------------------------------------------
	53	c 0.2 local arrays
	54	c ------------
	55
	56	integer ja,jl,jk,ig0
	57
	58	real zt_co2 (ndlon,nuco2)
	59	real zt_aer (ndlon,nuco2)
	60	real zu (ndlon,nuco2)
	61	real zup (ndlon,nuco2)
	62	c 2 for ground(1) and space(2)
	63	real trans (ndlon,nuco2,2,0:nflev+1)
	64	real ksi (ndlon,nuco2,2,0:nflev+1)
	65	c only for space
	66	real trans_emis (ndlon,nuco2,0:nflev+1)
	67	real ksi_emis (ndlon,nuco2,0:nflev+1)
	68
	69	c*************************************************************************
	70	c 1.0 Transmissions
	71	c -------------
	72	c----------------------------------------------------------------------
	73	c 1.1 Direct Transmission
	74	c -------------------
	75
	76	c space
	77	c -----
	78	do jk = 1 , nlaylte+1
	79
	80	do ja = 1 , nuco2
	81	do jl = 1 , kdlon
	82	zu(jl,ja) = co2_u(jl,ja,jk)
	83	zup(jl,ja) = co2_up(jl,ja,jk)
	84	zt_aer(jl,ja) = aer_t(jl,ja,jk)
	85	enddo
	86	enddo
	87
	88	call lwtt(kdlon,zu,zup,nuco2,zt_co2)
	89
	90	do ja = 1 , nuco2
	91	do jl = 1 , kdlon
	92	trans(jl,ja,2,jk)=zt_co2(jl,ja)*zt_aer(jl,ja)
	93	enddo
	94	enddo
	95
	96	enddo
	97	c ground
	98	c -----
	99	do jk = 1 , nlaylte+1
	100
	101	do ja = 1 , nuco2
	102	do jl = 1 , kdlon
	103	zu(jl,ja) = co2_u(jl,ja,1) - co2_u(jl,ja,jk)
	104	zup(jl,ja) = co2_up(jl,ja,1) - co2_up(jl,ja,jk)
	105	zt_aer(jl,ja) = aer_t(jl,ja,1) /aer_t(jl,ja,jk)
	106	enddo
	107	enddo
	108
	109	call lwtt(kdlon,zu,zup,nuco2,zt_co2)
	110
	111	do ja = 1 , nuco2
	112	do jl = 1 , kdlon
	113	trans(jl,ja,1,jk)=zt_co2(jl,ja)*zt_aer(jl,ja)
	114	enddo
	115	enddo
	116
	117	enddo
	118
	119	c----------------------------------------------------------------------
	120	c 1.2 Transmission with reflexion
	121	c ---------------------------
	122
	123	c space
	124	c -----
	125	do jk = 1 , nlaylte+1
	126
	127	do ja = 1 , nuco2
	128	do jl = 1 , kdlon
	129
	130	zu(jl,ja) = 2 * co2_u(jl,ja,1) - co2_u(jl,ja,jk)
	131	zup(jl,ja) = 2 * co2_up(jl,ja,1) - co2_up(jl,ja,jk)
	132	zt_aer(jl,ja) = aer_t(jl,ja,1)
	133	. * aer_t(jl,ja,1)
	134	. / aer_t(jl,ja,jk)
	135
	136	enddo
	137	enddo
	138
	139	call lwtt(kdlon,zu,zup,nuco2,zt_co2)
	140
	141	do ja = 1 , nuco2
	142	do jl = 1 , kdlon
	143	trans_emis(jl,ja,jk)=zt_co2(jl,ja)*zt_aer(jl,ja)
	144	enddo
	145	enddo
	146
	147	enddo
	148
	149	c*************************************************************************
	150	c 2.0 Exchange Coefficiants
	151	c ---------------------
	152
	153	do jk = 1 , nlaylte
	154	do ja = 1 , nuco2
	155	do jl = 1 , kdlon
	156
	157	c-------------------------------------------------------------------------
	158	c 2.1 colling to space (from layer 1,nlaylte toward "layer" nlaylte+1)
	159	c ----------------
	160
	161
	162	ksi(jl,ja,2,jk) = trans(jl,ja,2,jk+1)
	163	. - trans(jl,ja,2,jk)
	164
	165	ksi_emis(jl,ja,jk) = trans_emis(jl,ja,jk)
	166	. - trans_emis(jl,ja,jk+1)
	167
	168	xi(ig0+jl,ja,jk,nlaylte+1)= ksi(jl,ja,2,jk)
	169	. + ksi_emis(jl,ja,jk)* (1 - emis(jl))
	170
	171	c ksi Reciprocity
	172	c ---------------
	173	xi(ig0+jl,ja,nlaylte+1,jk) = xi(ig0+jl,ja,jk,nlaylte+1)
	174
	175	c-------------------------------------------------------------------------
	176	c 2.2 echange with ground (from "layer" 0 toward layers 1,nlaylte)
	177	c -------------------
	178
	179
	180	ksi(jl,ja,1,jk) = trans(jl,ja,1,jk)
	181	. - trans(jl,ja,1,jk+1)
	182
	183	xi(ig0+jl,ja,0,jk) = ksi(jl,ja,1,jk) * emis(jl)
	184
	185	c ksi Reciprocity
	186	c ---------------
	187	xi(ig0+jl,ja,jk,0) = xi(ig0+jl,ja,0,jk)
	188
	189	c-------------------------------------------------------------------------
	190	enddo
	191	enddo
	192	enddo
	193
	194	c-------------------------------------------------------------------------
	195	c 2.3 echange ground-space (from "layer" 0 toward "layer" nlaylte+1)
	196	c ----------------------
	197
	198	c Is not used because we use sigma T4 for the ground budget in physiq.F
	199
	200	do ja = 1 , nuco2
	201	do jl = 1 , kdlon
	202
	203	ksi(jl,ja,1,nlaylte+1) = trans(jl,ja,1,nlaylte+1)
	204	xi(ig0+jl,ja,0,nlaylte+1) = ksi(jl,ja,1,nlaylte+1) * emis(jl)
	205
	206	c ksi Reciprocity
	207	c ---------------
	208	xi(ig0+jl,ja,nlaylte+1,0) = xi(ig0+jl,ja,0,nlaylte+1)
	209
	210	enddo
	211	enddo
	212
	213	c-------------------------------------------------------------------------
	214	return
	215	end

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

Download in other formats:

Original Format