Context Navigation

geometry.f90 @ 971

Last change on this file since 971 was 879, checked in by dubos, 5 years ago
devel : introduced derived type to store cell bounds
File size: 6.7 KB

Rev	Line
[12]	1	MODULE geometry
	2	USE field_mod
[356]	3	IMPLICIT NONE
	4
[12]	5	TYPE t_geometry
[286]	6	TYPE(t_field),POINTER :: centroid(:)
[12]	7	TYPE(t_field),POINTER :: xyz_i(:)
	8	TYPE(t_field),POINTER :: xyz_e(:)
	9	TYPE(t_field),POINTER :: xyz_v(:)
[286]	10	TYPE(t_field),POINTER :: lon_i(:)
	11	TYPE(t_field),POINTER :: lon_e(:)
	12	TYPE(t_field),POINTER :: lat_i(:)
	13	TYPE(t_field),POINTER :: lat_e(:)
[15]	14	TYPE(t_field),POINTER :: ep_e(:)
	15	TYPE(t_field),POINTER :: et_e(:)
	16	TYPE(t_field),POINTER :: elon_i(:)
	17	TYPE(t_field),POINTER :: elat_i(:)
	18	TYPE(t_field),POINTER :: elon_e(:)
	19	TYPE(t_field),POINTER :: elat_e(:)
[12]	20	TYPE(t_field),POINTER :: Ai(:)
	21	TYPE(t_field),POINTER :: Av(:)
	22	TYPE(t_field),POINTER :: de(:)
	23	TYPE(t_field),POINTER :: le(:)
[362]	24	TYPE(t_field),POINTER :: le_de(:) ! le/de, 0. if de=0.
[12]	25	TYPE(t_field),POINTER :: Riv(:)
[427]	26	TYPE(t_field),POINTER :: S1(:)
	27	TYPE(t_field),POINTER :: S2(:)
[12]	28	TYPE(t_field),POINTER :: Riv2(:)
	29	TYPE(t_field),POINTER :: ne(:)
	30	TYPE(t_field),POINTER :: Wee(:)
	31	TYPE(t_field),POINTER :: bi(:)
	32	TYPE(t_field),POINTER :: fv(:)
	33	END TYPE t_geometry
	34
[186]	35	TYPE(t_geometry),SAVE,TARGET :: geom
	36
[12]	37
[15]	38	REAL(rstd),POINTER :: Ai(:) ! area of a cell
[186]	39	!$OMP THREADPRIVATE(Ai)
[286]	40	REAL(rstd),POINTER :: centroid(:,:) ! coordinate of the centroid of the cell
	41	!$OMP THREADPRIVATE(centroid)
[15]	42	REAL(rstd),POINTER :: xyz_i(:,:) ! coordinate of the center of the cell (voronoi)
[186]	43	!$OMP THREADPRIVATE(xyz_i)
[15]	44	REAL(rstd),POINTER :: xyz_e(:,:) ! coordinate of a wind point on the cell on a edge
[186]	45	!$OMP THREADPRIVATE(xyz_e)
[286]	46	REAL(rstd),POINTER :: xyz_v(:,:) ! coordinate of a vertex (center of the dual mesh)
	47	!$OMP THREADPRIVATE(xyz_v)
	48	REAL(rstd),POINTER :: lon_i(:) ! longitude of the center of the cell (voronoi)
	49	!$OMP THREADPRIVATE(lon_i)
	50	REAL(rstd),POINTER :: lon_e(:) ! longitude of a wind point on the cell on a edge
	51	!$OMP THREADPRIVATE(lon_e)
	52	REAL(rstd),POINTER :: lat_i(:) ! latitude of the center of the cell (voronoi)
	53	!$OMP THREADPRIVATE(lat_i)
	54	REAL(rstd),POINTER :: lat_e(:) ! latitude of a wind point on the cell on a edge
	55	!$OMP THREADPRIVATE(lat_e)
[15]	56	REAL(rstd),POINTER :: ep_e(:,:) ! perpendicular unit vector of a edge (outsider)
[186]	57	!$OMP THREADPRIVATE(ep_e)
[15]	58	REAL(rstd),POINTER :: et_e(:,:) ! tangeantial unit vector of a edge
[186]	59	!$OMP THREADPRIVATE(et_e)
[15]	60	REAL(rstd),POINTER :: elon_i(:,:) ! unit longitude vector on the center
[186]	61	!$OMP THREADPRIVATE(elon_i)
[15]	62	REAL(rstd),POINTER :: elat_i(:,:) ! unit latitude vector on the center
[186]	63	!$OMP THREADPRIVATE(elat_i)
[15]	64	REAL(rstd),POINTER :: elon_e(:,:) ! unit longitude vector on a wind point
[186]	65	!$OMP THREADPRIVATE(elon_e)
[15]	66	REAL(rstd),POINTER :: elat_e(:,:) ! unit latitude vector on a wind point
[186]	67	!$OMP THREADPRIVATE(elat_e)
[15]	68	REAL(rstd),POINTER :: Av(:) ! area of dual mesk cell
[186]	69	!$OMP THREADPRIVATE(Av)
[15]	70	REAL(rstd),POINTER :: de(:) ! distance from a neighbour == lenght of an edge of the dual mesh
[186]	71	!$OMP THREADPRIVATE(de)
[15]	72	REAL(rstd),POINTER :: le(:) ! lenght of a edge
[186]	73	!$OMP THREADPRIVATE(le)
[427]	74	REAL(rstd),POINTER :: le_de(:) ! le/de
[362]	75	!$OMP THREADPRIVATE(le_de)
[427]	76	REAL(rstd),POINTER :: S1(:,:) ! area of sub-triangle
	77	!$OMP THREADPRIVATE(S1)
	78	REAL(rstd),POINTER :: S2(:,:) ! area of sub-tirangle
	79	!$OMP THREADPRIVATE(S2)
[15]	80	REAL(rstd),POINTER :: Riv(:,:) ! weight
[186]	81	!$OMP THREADPRIVATE(Riv)
[15]	82	REAL(rstd),POINTER :: Riv2(:,:) ! weight
[186]	83	!$OMP THREADPRIVATE(Riv2)
[15]	84	INTEGER,POINTER :: ne(:,:) ! convention for the way on the normal wind on an edge
[186]	85	!$OMP THREADPRIVATE(ne)
[15]	86	REAL(rstd),POINTER :: Wee(:,:,:) ! weight
[186]	87	!$OMP THREADPRIVATE(Wee)
[15]	88	REAL(rstd),POINTER :: bi(:) ! orographie
[186]	89	!$OMP THREADPRIVATE(bi)
[15]	90	REAL(rstd),POINTER :: fv(:) ! coriolis (evaluted on a vertex)
[186]	91	!$OMP THREADPRIVATE(fv)
[12]	92
	93
[146]	94	INTEGER, PARAMETER :: ne_right=1
	95	INTEGER, PARAMETER :: ne_rup=-1
	96	INTEGER, PARAMETER :: ne_lup=1
	97	INTEGER, PARAMETER :: ne_left=-1
	98	INTEGER, PARAMETER :: ne_ldown=1
	99	INTEGER, PARAMETER :: ne_rdown=-1
[153]	100
[12]	101	CONTAINS
	102
	103	SUBROUTINE allocate_geometry
	104	USE field_mod
	105	IMPLICIT NONE
[879]	106	INTEGER, PARAMETER :: nvertex=6 ! FIXME unstructured
	107
[266]	108	CALL allocate_field(geom%Ai,field_t,type_real,name='Ai')
[286]	109
[12]	110	CALL allocate_field(geom%xyz_i,field_t,type_real,3)
[879]	111	CALL allocate_field(geom%lon_i,field_t,type_real, name='lon_i')
	112	CALL allocate_field(geom%lat_i,field_t,type_real, name='lat_i')
[286]	113	CALL allocate_field(geom%elon_i,field_t,type_real,3)
	114	CALL allocate_field(geom%elat_i,field_t,type_real,3)
[15]	115	CALL allocate_field(geom%centroid,field_t,type_real,3)
[286]	116
[12]	117	CALL allocate_field(geom%xyz_e,field_u,type_real,3)
[879]	118	CALL allocate_field(geom%lon_e,field_u,type_real, name='lon_e')
	119	CALL allocate_field(geom%lat_e,field_u,type_real, name='lat_e')
[286]	120	CALL allocate_field(geom%elon_e,field_u,type_real,3)
	121	CALL allocate_field(geom%elat_e,field_u,type_real,3)
[15]	122	CALL allocate_field(geom%ep_e,field_u,type_real,3)
	123	CALL allocate_field(geom%et_e,field_u,type_real,3)
[286]	124
[12]	125	CALL allocate_field(geom%xyz_v,field_z,type_real,3)
[879]	126	CALL allocate_field(geom%de,field_u,type_real, name='de')
	127	CALL allocate_field(geom%le,field_u,type_real, name='le')
	128	CALL allocate_field(geom%le_de,field_u,type_real, name='le_de')
[12]	129	CALL allocate_field(geom%bi,field_t,type_real)
[879]	130	CALL allocate_field(geom%Av,field_z,type_real, name='Av')
	131	CALL allocate_field(geom%S1,field_t,type_real,nvertex)
	132	CALL allocate_field(geom%S2,field_t,type_real,nvertex)
	133	CALL allocate_field(geom%Riv,field_t,type_real,nvertex)
	134	CALL allocate_field(geom%Riv2,field_t,type_real,nvertex)
	135	CALL allocate_field(geom%ne,field_t,type_integer,nvertex)
	136	CALL allocate_field(geom%Wee,field_u,type_real,5,2) ! FIXME unstructured
[12]	137	CALL allocate_field(geom%bi,field_t,type_real)
[879]	138	CALL allocate_field(geom%fv,field_z,type_real, name='fv')
[12]	139
	140	END SUBROUTINE allocate_geometry
	141
	142
	143	SUBROUTINE swap_geometry(ind)
	144	USE field_mod
[856]	145	USE domain_mod, ONLY : swap_needed
[12]	146	IMPLICIT NONE
	147	INTEGER,INTENT(IN) :: ind
[856]	148
	149	IF(.NOT. swap_needed) RETURN
	150
[186]	151	!!$OMP MASTER
[12]	152	Ai=geom%Ai(ind)
	153	xyz_i=geom%xyz_i(ind)
[15]	154	centroid=geom%centroid(ind)
[12]	155	xyz_e=geom%xyz_e(ind)
[15]	156	ep_e=geom%ep_e(ind)
	157	et_e=geom%et_e(ind)
[286]	158	lon_i=geom%lon_i(ind)
	159	lat_i=geom%lat_i(ind)
	160	lon_e=geom%lon_e(ind)
	161	lat_e=geom%lat_e(ind)
[15]	162	elon_i=geom%elon_i(ind)
	163	elat_i=geom%elat_i(ind)
	164	elon_e=geom%elon_e(ind)
	165	elat_e=geom%elat_e(ind)
[12]	166	xyz_v=geom%xyz_v(ind)
	167	de=geom%de(ind)
	168	le=geom%le(ind)
[362]	169	le_de=geom%le_de(ind)
[12]	170	Av=geom%Av(ind)
[427]	171	S1=geom%S1(ind)
	172	S2=geom%S2(ind)
[12]	173	Riv=geom%Riv(ind)
	174	Riv2=geom%Riv2(ind)
	175	ne=geom%ne(ind)
	176	Wee=geom%Wee(ind)
	177	bi=geom%bi(ind)
	178	fv=geom%fv(ind)
[186]	179	!!$OMP END MASTER
	180	!!$OMP BARRIER
[12]	181	END SUBROUTINE swap_geometry
[153]	182
[12]	183	END MODULE geometry

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

Context Navigation

source: codes/icosagcm/devel/src/sphere/geometry.f90 @ 971

Download in other formats: