Context Navigation

cv3a_compress.F @ 5360

Last change on this file since 5360 was 1299, checked in by Laurent Fairhead, 15 years ago

Nettoyage general pour se rapprocher des normes et éviter des erreurs a la
compilation:

tous les FLOAT() sont remplacés par des REAL()
tous les STOP dans phylmd sont remplacés par des appels à abort_gcm
le common control défini dans le fichier control.h est remplacé par le module control_mod pour éviter des messages sur l'alignement des variables dans les déclarations
des $Header$ remplacés par des $Id$ pour svn

Quelques remplacements à faire ont pu m'échapper

General cleanup of the code to try and adhere to norms and to prevent some
compilation errors:

all FLOAT() instructions have been replaced by REAL() instructions
all STOP instructions in phylmd have been replaced by calls to abort_gcm
the common block control defined in the control.h file has been replaced by the control_mod to prevent compilation warnings on the alignement of declared variables
$Header$ replaced by $Id$ for svn

Some changes which should have been made might have escaped me

Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 5.0 KB

Rev	Line
[879]	1	SUBROUTINE cv3a_compress( len,nloc,ncum,nd,ntra
	2	: ,iflag1,nk1,icb1,icbs1
	3	: ,plcl1,tnk1,qnk1,gznk1,hnk1,unk1,vnk1
	4	: ,wghti1,pbase1,buoybase1
[1146]	5	: ,t1,q1,qs1,t1_wake,q1_wake,qs1_wake,s1_wake
	6	: ,u1,v1,gz1,th1,th1_wake
[879]	7	: ,tra1
	8	: ,h1 ,lv1 ,cpn1 ,p1,ph1,tv1 ,tp1,tvp1,clw1
	9	: ,h1_wake,lv1_wake,cpn1_wake ,tv1_wake
	10	: ,sig1,w01,ptop21
	11	: ,Ale1,Alp1
	12	o ,iflag,nk,icb,icbs
	13	o ,plcl,tnk,qnk,gznk,hnk,unk,vnk
	14	o ,wghti,pbase,buoybase
[1146]	15	o ,t,q,qs,t_wake,q_wake,qs_wake,s_wake
	16	o ,u,v,gz,th,th_wake
[879]	17	o ,tra
	18	o ,h ,lv ,cpn ,p,ph,tv ,tp,tvp,clw
	19	o ,h_wake,lv_wake,cpn_wake ,tv_wake
	20	o ,sig,w0,ptop2
	21	o ,Ale,Alp )
	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	***************************************************************
	30	*
	31	implicit none
	32
	33	#include "cv3param.h"
	34
	35	c inputs:
	36	integer len,nloc,ncum,nd,ntra
	37	integer iflag1(len),nk1(len),icb1(len),icbs1(len)
	38	real plcl1(len),tnk1(len),qnk1(len),gznk1(len)
	39	real hnk1(len),unk1(len),vnk1(len)
	40	real wghti1(len,nd),pbase1(len),buoybase1(len)
	41	real t1(len,nd),q1(len,nd),qs1(len,nd)
	42	real t1_wake(len,nd),q1_wake(len,nd),qs1_wake(len,nd)
[1146]	43	real s1_wake(len)
[879]	44	real u1(len,nd),v1(len,nd)
	45	real gz1(len,nd),th1(len,nd),th1_wake(len,nd)
	46	real tra1(len,nd,ntra)
	47	real h1(len,nd),lv1(len,nd),cpn1(len,nd)
	48	real p1(len,nd),ph1(len,nd+1),tv1(len,nd),tp1(len,nd)
	49	real tvp1(len,nd),clw1(len,nd)
	50	real h1_wake(len,nd),lv1_wake(len,nd),cpn1_wake(len,nd)
	51	real tv1_wake(len,nd)
	52	real sig1(len,nd), w01(len,nd), ptop21(len)
	53	real Ale1(len),Alp1(len)
	54
	55	c outputs:
	56	c en fait, on a nloc=len pour l'instant (cf cv_driver)
	57	integer iflag(len),nk(len),icb(len),icbs(len)
	58	real plcl(len),tnk(len),qnk(len),gznk(len)
	59	real hnk(len),unk(len),vnk(len)
	60	real wghti(len,nd),pbase(len),buoybase(len)
	61	real t(len,nd),q(len,nd),qs(len,nd)
	62	real t_wake(len,nd),q_wake(len,nd),qs_wake(len,nd)
[1146]	63	real s_wake(len)
[879]	64	real u(len,nd),v(len,nd)
	65	real gz(len,nd),th(len,nd),th_wake(len,nd)
	66	real tra(len,nd,ntra)
	67	real h(len,nd),lv(len,nd),cpn(len,nd)
	68	real p(len,nd),ph(len,nd+1),tv(len,nd),tp(len,nd)
	69	real tvp(len,nd),clw(len,nd)
	70	real h_wake(len,nd),lv_wake(len,nd),cpn_wake(len,nd)
	71	real tv_wake(len,nd)
	72	real sig(len,nd), w0(len,nd), ptop2(len)
	73	real Ale(len),Alp(len)
	74
	75	c local variables:
	76	integer i,k,nn,j
	77
[1299]	78	CHARACTER (LEN=20) :: modname='cv3a_compress'
	79	CHARACTER (LEN=80) :: abort_message
[879]	80
[1299]	81
[879]	82	do 110 k=1,nl+1
	83	nn=0
	84	do 100 i=1,len
	85	if(iflag1(i).eq.0)then
	86	nn=nn+1
	87	wghti(nn,k)=wghti1(i,k)
	88	t(nn,k)=t1(i,k)
	89	q(nn,k)=q1(i,k)
	90	qs(nn,k)=qs1(i,k)
	91	t_wake(nn,k)=t1_wake(i,k)
	92	q_wake(nn,k)=q1_wake(i,k)
	93	qs_wake(nn,k)=qs1_wake(i,k)
	94	u(nn,k)=u1(i,k)
	95	v(nn,k)=v1(i,k)
	96	gz(nn,k)=gz1(i,k)
	97	th(nn,k)=th1(i,k)
	98	th_wake(nn,k)=th1_wake(i,k)
	99	h(nn,k)=h1(i,k)
	100	lv(nn,k)=lv1(i,k)
	101	cpn(nn,k)=cpn1(i,k)
	102	p(nn,k)=p1(i,k)
	103	ph(nn,k)=ph1(i,k)
	104	tv(nn,k)=tv1(i,k)
	105	tp(nn,k)=tp1(i,k)
	106	tvp(nn,k)=tvp1(i,k)
	107	clw(nn,k)=clw1(i,k)
	108	h_wake(nn,k)=h1_wake(i,k)
	109	lv_wake(nn,k)=lv1_wake(i,k)
	110	cpn_wake(nn,k)=cpn1_wake(i,k)
	111	tv_wake(nn,k)=tv1_wake(i,k)
	112	sig(nn,k)=sig1(i,k)
	113	w0(nn,k)=w01(i,k)
	114	endif
	115	100 continue
	116	110 continue
	117
	118	do 121 j=1,ntra
	119	ccccc do 111 k=1,nl+1
	120	do 111 k=1,nd
	121	nn=0
	122	do 101 i=1,len
	123	if(iflag1(i).eq.0)then
	124	nn=nn+1
	125	tra(nn,k,j)=tra1(i,k,j)
	126	endif
	127	101 continue
	128	111 continue
	129	121 continue
	130
	131	if (nn.ne.ncum) then
[1299]	132	print*,'WARNING nn not equal to ncum: ',nn,ncum
	133	abort_message = ''
	134	CALL abort_gcm (modname,abort_message,1)
[879]	135	endif
	136
	137	nn=0
	138	do 150 i=1,len
	139	if(iflag1(i).eq.0)then
	140	nn=nn+1
[1146]	141	s_wake(nn)=s1_wake(i)
[879]	142	iflag(nn)=iflag1(i)
	143	nk(nn)=nk1(i)
	144	icb(nn)=icb1(i)
	145	icbs(nn)=icbs1(i)
	146	plcl(nn)=plcl1(i)
	147	tnk(nn)=tnk1(i)
	148	qnk(nn)=qnk1(i)
	149	gznk(nn)=gznk1(i)
	150	hnk(nn)=hnk1(i)
	151	unk(nn)=unk1(i)
	152	vnk(nn)=vnk1(i)
	153	pbase(nn)=pbase1(i)
	154	buoybase(nn)=buoybase1(i)
	155	ptop2(nn)=ptop2(i)
	156	ale(nn) = ale1(i)
	157	alp(nn) = alp1(i)
	158	endif
	159	150 continue
	160
[972]	161	if (nn.ne.ncum) then
	162	print*,'WARNING nn not equal to ncum: ',nn,ncum
[1299]	163	abort_message = ''
	164	CALL abort_gcm (modname,abort_message,1)
[972]	165	endif
	166
[879]	167	RETURN
	168	END

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

Download in other formats:

Original Format