Context Navigation

cv3a_compress.f90 @ 5394

Last change on this file since 5394 was 5346, checked in by fhourdin, 2 weeks ago

Debut de replaysation de la convection profonde.

Regroupement de cvparam, cv3param et cvthermo (récemment
passés de statut de .h à module, dans un unique module
lmdz_cv_ini.f90

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: 9.0 KB

Rev	Line
[2253]	1	SUBROUTINE cv3a_compress(len, nloc, ncum, nd, ntra, compress, &
	2	iflag1, nk1, icb1, icbs1, &
	3	plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, &
	4	wghti1, pbase1, buoybase1, &
	5	t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &
	6	u1, v1, gz1, th1, th1_wake, &
	7	tra1, &
	8	h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
	9	h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, &
	10	sig1, w01, ptop21, &
	11	Ale1, Alp1, omega1, &
	12	iflag, nk, icb, icbs, &
	13	plcl, tnk, qnk, gznk, hnk, unk, vnk, &
	14	wghti, pbase, buoybase, &
	15	t, q, qs, t_wake, q_wake, qs_wake, s_wake, &
	16	u, v, gz, th, th_wake, &
	17	tra, &
	18	h, lv, lf, cpn, p, ph, tv, tp, tvp, clw, &
	19	h_wake, lv_wake, lf_wake, cpn_wake, tv_wake, &
	20	sig, w0, ptop2, &
	21	Ale, Alp, omega)
[1992]	22	! **************************************************************
	23	! *
	24	! CV3A_COMPRESS *
	25	! *
	26	! *
	27	! written by : Sandrine Bony-Lena , 17/05/2003, 11.22.15 *
	28	! modified by : Jean-Yves Grandpeix, 23/06/2003, 10.28.09 *
	29	! **************************************************************
[879]	30
[5346]	31	USE lmdz_cv_ini, ONLY : nl
[5299]	32	IMPLICIT NONE
[879]	33
	34
[1992]	35	! inputs:
[2253]	36	INTEGER, INTENT (IN) :: len, nloc, nd, ntra
	37	!jyg<
	38	LOGICAL, INTENT (IN) :: compress ! compression is performed if compress is true
	39	!>jyg
	40	INTEGER, DIMENSION (len), INTENT (IN) :: iflag1, nk1, icb1, icbs1
	41	REAL, DIMENSION (len), INTENT (IN) :: plcl1, tnk1, qnk1, gznk1
	42	REAL, DIMENSION (len), INTENT (IN) :: hnk1, unk1, vnk1
	43	REAL, DIMENSION (len, nd), INTENT (IN) :: wghti1(len, nd)
	44	REAL, DIMENSION (len), INTENT (IN) :: pbase1, buoybase1
	45	REAL, DIMENSION (len, nd), INTENT (IN) :: t1, q1, qs1
	46	REAL, DIMENSION (len, nd), INTENT (IN) :: t1_wake, q1_wake, qs1_wake
	47	REAL, DIMENSION (len), INTENT (IN) :: s1_wake
	48	REAL, DIMENSION (len, nd), INTENT (IN) :: u1, v1
	49	REAL, DIMENSION (len, nd), INTENT (IN) :: gz1, th1, th1_wake
	50	REAL, DIMENSION (len, nd,ntra), INTENT (IN) :: tra1
	51	REAL, DIMENSION (len, nd), INTENT (IN) :: h1, lv1, lf1, cpn1
	52	REAL, DIMENSION (len, nd), INTENT (IN) :: p1
	53	REAL, DIMENSION (len, nd+1), INTENT (IN) :: ph1(len, nd+1)
	54	REAL, DIMENSION (len, nd), INTENT (IN) :: tv1, tp1
	55	REAL, DIMENSION (len, nd), INTENT (IN) :: tvp1, clw1
	56	REAL, DIMENSION (len, nd), INTENT (IN) :: h1_wake, lv1_wake, cpn1_wake
	57	REAL, DIMENSION (len, nd), INTENT (IN) :: tv1_wake, lf1_wake
	58	REAL, DIMENSION (len, nd), INTENT (IN) :: sig1, w01
	59	REAL, DIMENSION (len), INTENT (IN) :: ptop21
	60	REAL, DIMENSION (len), INTENT (IN) :: Ale1, Alp1
	61	REAL, DIMENSION (len, nd), INTENT (IN) :: omega1
	62	!
	63	! in/out
	64	INTEGER, INTENT (INOUT) :: ncum
	65	!
[1992]	66	! outputs:
	67	! en fait, on a nloc=len pour l'instant (cf cv_driver)
[2253]	68	INTEGER, DIMENSION (nloc), INTENT (OUT) :: iflag, nk, icb, icbs
	69	REAL, DIMENSION (nloc), INTENT (OUT) :: plcl, tnk, qnk, gznk
	70	REAL, DIMENSION (nloc), INTENT (OUT) :: hnk, unk, vnk
	71	REAL, DIMENSION (nloc, nd), INTENT (OUT) :: wghti
	72	REAL, DIMENSION (nloc), INTENT (OUT) :: pbase, buoybase
	73	REAL, DIMENSION (nloc, nd), INTENT (OUT) :: t, q, qs
	74	REAL, DIMENSION (nloc, nd), INTENT (OUT) :: t_wake, q_wake, qs_wake
	75	REAL, DIMENSION (nloc), INTENT (OUT) :: s_wake
	76	REAL, DIMENSION (nloc, nd), INTENT (OUT) :: u, v
	77	REAL, DIMENSION (nloc, nd), INTENT (OUT) :: gz, th, th_wake
	78	REAL, DIMENSION (nloc, nd,ntra), INTENT (OUT) :: tra
	79	REAL, DIMENSION (nloc, nd), INTENT (OUT) :: h, lv, lf, cpn
	80	REAL, DIMENSION (nloc, nd), INTENT (OUT) :: p
	81	REAL, DIMENSION (nloc, nd+1), INTENT (OUT) :: ph
	82	REAL, DIMENSION (nloc, nd), INTENT (OUT) :: tv, tp
	83	REAL, DIMENSION (nloc, nd), INTENT (OUT) :: tvp, clw
	84	REAL, DIMENSION (nloc, nd), INTENT (OUT) :: h_wake, lv_wake, cpn_wake
	85	REAL, DIMENSION (nloc, nd), INTENT (OUT) :: tv_wake, lf_wake
	86	REAL, DIMENSION (nloc, nd), INTENT (OUT) :: sig, w0
	87	REAL, DIMENSION (nloc), INTENT (OUT) :: ptop2
	88	REAL, DIMENSION (nloc), INTENT (OUT) :: Ale, Alp
	89	REAL, DIMENSION (nloc, nd), INTENT (OUT) :: omega
[879]	90
[1992]	91	! local variables:
	92	INTEGER i, k, nn, j
[879]	93
[1992]	94	CHARACTER (LEN=20) :: modname = 'cv3a_compress'
	95	CHARACTER (LEN=80) :: abort_message
[1403]	96
[2253]	97	!jyg<
	98	IF (compress) THEN
	99	!>jyg
[879]	100
[1992]	101	DO k = 1, nl + 1
	102	nn = 0
	103	DO i = 1, len
	104	IF (iflag1(i)==0) THEN
	105	nn = nn + 1
	106	wghti(nn, k) = wghti1(i, k)
	107	t(nn, k) = t1(i, k)
	108	q(nn, k) = q1(i, k)
	109	qs(nn, k) = qs1(i, k)
	110	t_wake(nn, k) = t1_wake(i, k)
	111	q_wake(nn, k) = q1_wake(i, k)
	112	qs_wake(nn, k) = qs1_wake(i, k)
	113	u(nn, k) = u1(i, k)
	114	v(nn, k) = v1(i, k)
	115	gz(nn, k) = gz1(i, k)
	116	th(nn, k) = th1(i, k)
	117	th_wake(nn, k) = th1_wake(i, k)
	118	h(nn, k) = h1(i, k)
	119	lv(nn, k) = lv1(i, k)
	120	lf(nn, k) = lf1(i, k)
	121	cpn(nn, k) = cpn1(i, k)
	122	p(nn, k) = p1(i, k)
	123	ph(nn, k) = ph1(i, k)
	124	tv(nn, k) = tv1(i, k)
	125	tp(nn, k) = tp1(i, k)
	126	tvp(nn, k) = tvp1(i, k)
	127	clw(nn, k) = clw1(i, k)
	128	h_wake(nn, k) = h1_wake(i, k)
	129	lv_wake(nn, k) = lv1_wake(i, k)
	130	lf_wake(nn, k) = lf1_wake(i, k)
	131	cpn_wake(nn, k) = cpn1_wake(i, k)
	132	tv_wake(nn, k) = tv1_wake(i, k)
	133	sig(nn, k) = sig1(i, k)
	134	w0(nn, k) = w01(i, k)
[2201]	135	omega(nn, k) = omega1(i, k)
[1992]	136	END IF
	137	END DO
	138	END DO
[2253]	139	!
[1992]	140	! AC! do 121 j=1,ntra
	141	! AC!ccccc do 111 k=1,nl+1
	142	! AC! do 111 k=1,nd
	143	! AC! nn=0
	144	! AC! do 101 i=1,len
	145	! AC! if(iflag1(i).eq.0)then
	146	! AC! nn=nn+1
	147	! AC! tra(nn,k,j)=tra1(i,k,j)
	148	! AC! endif
	149	! AC! 101 continue
	150	! AC! 111 continue
	151	! AC! 121 continue
[879]	152
[1992]	153	IF (nn/=ncum) THEN
	154	PRINT *, 'WARNING nn not equal to ncum: ', nn, ncum
	155	abort_message = ''
[2311]	156	CALL abort_physic(modname, abort_message, 1)
[1992]	157	END IF
	158
	159	nn = 0
	160	DO i = 1, len
	161	IF (iflag1(i)==0) THEN
	162	nn = nn + 1
	163	s_wake(nn) = s1_wake(i)
	164	iflag(nn) = iflag1(i)
	165	nk(nn) = nk1(i)
	166	icb(nn) = icb1(i)
	167	icbs(nn) = icbs1(i)
	168	plcl(nn) = plcl1(i)
	169	tnk(nn) = tnk1(i)
	170	qnk(nn) = qnk1(i)
	171	gznk(nn) = gznk1(i)
	172	hnk(nn) = hnk1(i)
	173	unk(nn) = unk1(i)
	174	vnk(nn) = vnk1(i)
	175	pbase(nn) = pbase1(i)
	176	buoybase(nn) = buoybase1(i)
[2259]	177	sig(nn, nd) = sig1(i, nd)
[1992]	178	ptop2(nn) = ptop2(i)
[2253]	179	Ale(nn) = Ale1(i)
	180	Alp(nn) = Alp1(i)
[1992]	181	END IF
	182	END DO
[879]	183
[1992]	184	IF (nn/=ncum) THEN
	185	PRINT *, 'WARNING nn not equal to ncum: ', nn, ncum
	186	abort_message = ''
[2311]	187	CALL abort_physic(modname, abort_message, 1)
[1992]	188	END IF
[2253]	189	!
	190	!jyg<
	191	ELSE !(compress)
	192	!
	193	ncum = len
	194	!
[2259]	195	wghti(:,1:nl+1) = wghti1(:,1:nl+1)
	196	t(:,1:nl+1) = t1(:,1:nl+1)
	197	q(:,1:nl+1) = q1(:,1:nl+1)
	198	qs(:,1:nl+1) = qs1(:,1:nl+1)
	199	t_wake(:,1:nl+1) = t1_wake(:,1:nl+1)
	200	q_wake(:,1:nl+1) = q1_wake(:,1:nl+1)
	201	qs_wake(:,1:nl+1) = qs1_wake(:,1:nl+1)
	202	u(:,1:nl+1) = u1(:,1:nl+1)
	203	v(:,1:nl+1) = v1(:,1:nl+1)
	204	gz(:,1:nl+1) = gz1(:,1:nl+1)
	205	th(:,1:nl+1) = th1(:,1:nl+1)
	206	th_wake(:,1:nl+1) = th1_wake(:,1:nl+1)
	207	h(:,1:nl+1) = h1(:,1:nl+1)
	208	lv(:,1:nl+1) = lv1(:,1:nl+1)
	209	lf(:,1:nl+1) = lf1(:,1:nl+1)
	210	cpn(:,1:nl+1) = cpn1(:,1:nl+1)
	211	p(:,1:nl+1) = p1(:,1:nl+1)
	212	ph(:,1:nl+1) = ph1(:,1:nl+1)
	213	tv(:,1:nl+1) = tv1(:,1:nl+1)
	214	tp(:,1:nl+1) = tp1(:,1:nl+1)
	215	tvp(:,1:nl+1) = tvp1(:,1:nl+1)
	216	clw(:,1:nl+1) = clw1(:,1:nl+1)
	217	h_wake(:,1:nl+1) = h1_wake(:,1:nl+1)
	218	lv_wake(:,1:nl+1) = lv1_wake(:,1:nl+1)
	219	lf_wake(:,1:nl+1) = lf1_wake(:,1:nl+1)
	220	cpn_wake(:,1:nl+1) = cpn1_wake(:,1:nl+1)
	221	tv_wake(:,1:nl+1) = tv1_wake(:,1:nl+1)
	222	sig(:,1:nl+1) = sig1(:,1:nl+1)
	223	w0(:,1:nl+1) = w01(:,1:nl+1)
	224	omega(:,1:nl+1) = omega1(:,1:nl+1)
[2253]	225	!
	226	s_wake(:) = s1_wake(:)
	227	iflag(:) = iflag1(:)
	228	nk(:) = nk1(:)
	229	icb(:) = icb1(:)
	230	icbs(:) = icbs1(:)
	231	plcl(:) = plcl1(:)
	232	tnk(:) = tnk1(:)
	233	qnk(:) = qnk1(:)
	234	gznk(:) = gznk1(:)
	235	hnk(:) = hnk1(:)
	236	unk(:) = unk1(:)
	237	vnk(:) = vnk1(:)
	238	pbase(:) = pbase1(:)
	239	buoybase(:) = buoybase1(:)
[2259]	240	sig(:, nd) = sig1(:, nd)
[2253]	241	ptop2(:) = ptop2(:)
	242	Ale(:) = Ale1(:)
	243	Alp(:) = Alp1(:)
	244	!
	245	ENDIF !(compress)
	246	!>jyg
[972]	247
[1992]	248	RETURN
	249	END SUBROUTINE cv3a_compress

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

Download in other formats:

Original Format