Home

Context Navigation

source: palm/trunk/SOURCE/pmc_general.f90 @ 1763

Last change on this file since 1763 was 1763, checked in by hellstea, 8 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 9.3 KB

Line
1	MODULE pmc_general
2
3	!--------------------------------------------------------------------------------!
4	! This file is part of PALM.
5	!
6	! PALM is free software: you can redistribute it and/or modify it under the terms
7	! of the GNU General Public License as published by the Free Software Foundation,
8	! either version 3 of the License, or (at your option) any later version.
9	!
10	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
13	!
14	! You should have received a copy of the GNU General Public License along with
15	! PALM. If not, see <http://www.gnu.org/licenses/>.
16	!
17	! Copyright 1997-2015 Leibniz Universitaet Hannover
18	!--------------------------------------------------------------------------------!
19	!
20	! Current revisions:
21	! ------------------
22	!
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: pmc_general.f90 1763 2016-02-25 13:00:19Z hellstea $
27	!
28	! 1762 2016-02-25 12:31:13Z hellstea
29	! Initial revision by K. Ketelsen
30	!
31	! Description:
32	! ------------
33	!
34	! Structure definition and utilities of Palm Model Coupler
35	!------------------------------------------------------------------------------!
36
37
38	use, intrinsic :: iso_c_binding
39	USE :: MPI
40
41	IMPLICIT none
42	PRIVATE
43	SAVE
44
45	! return status
46	INTEGER,parameter,PUBLIC :: PMC_STATUS_OK = 0
47	INTEGER,parameter,PUBLIC :: PMC_STATUS_ERROR = -1
48	INTEGER,parameter,PUBLIC :: PMC_DA_NAME_ERR = 10
49
50	INTEGER,parameter,PUBLIC :: PMC_MAX_MODELL = 64
51	! TO_DO: the next variable doesn't seem to be used. Remove?
52	INTEGER,parameter,PUBLIC :: PMC_MPI_REAL = MPI_DOUBLE_PRECISION
53	INTEGER,parameter,PUBLIC :: DA_Desclen = 8
54	INTEGER,parameter,PUBLIC :: DA_Namelen = 16
55
56	TYPE, PUBLIC :: xy_ind ! Pair of indices in horizontal plane
57	INTEGER :: i
58	INTEGER :: j
59	END TYPE
60
61	TYPE, PUBLIC :: ArrayDef
62	INTEGER :: coupleIndex
63	INTEGER :: NrDims ! Number of Dimensions
64	INTEGER,DIMENSION(4) :: A_dim ! Size of dimensions
65	INTEGER :: dim_order ! Order of Dimensions: 2 = 2D array, 33 = 3D array
66	TYPE (c_ptr) :: data ! Pointer of data in server space
67	INTEGER(kind=8) :: BufIndex ! index in Send Buffer
68	INTEGER :: BufSize ! size in Send Buffer
69	TYPE (c_ptr) :: SendBuf ! Pointer of Data in Send buffer
70	CHARACTER(len=8) :: Name ! Name of Array
71
72	Type(ArrayDef),POINTER :: next
73	END TYPE ArrayDef
74
75	TYPE (ArrayDef), PUBLIC, POINTER :: next;
76
77	TYPE, PUBLIC :: PeDef
78	INTEGER(KIND=8) :: NrEle ! Number of Elemets
79	TYPE (xy_ind), POINTER,DIMENSION(:) :: locInd ! xy index local array for remote PE
80	TYPE( ArrayDef), POINTER :: Arrays ! Pointer to Data Array List (Type ArrayDef)
81	TYPE( ArrayDef), POINTER :: ArrayStart ! Pointer to Star of the List
82	END TYPE PeDef
83
84	TYPE, PUBLIC :: ClientDef
85	INTEGER(KIND=8) :: TotalBufferSize
86	INTEGER :: model_comm ! Communicator of this model
87	INTEGER :: inter_comm ! Inter communicator model and client
88	INTEGER :: intra_comm ! Intra communicator model and client
89	INTEGER :: model_rank ! Rank of this model
90	INTEGER :: model_npes ! Number of PEs this model
91	INTEGER :: inter_npes ! Number of PEs client model
92	INTEGER :: intra_rank ! rank within intra_comm
93	INTEGER :: BufWin ! MPI RMA windows
94	TYPE (PeDef), DIMENSION(:), POINTER :: PEs ! List of all Client PEs
95	END TYPE ClientDef
96
97	TYPE, PUBLIC :: DA_NameDef ! Data Array Name Definition
98	INTEGER :: couple_index ! Unique Number of Array
99	CHARACTER(len=DA_Desclen) :: ServerDesc ! Server array description
100	CHARACTER(len=DA_Namelen) :: NameOnServer ! Name of array within Server
101	CHARACTER(len=DA_Desclen) :: ClientDesc ! Client array description
102	CHARACTER(len=DA_Namelen) :: NameOnClient ! Name of array within Client
103	END TYPE DA_NameDef
104
105	INTERFACE PMC_G_SetName
106	MODULE procedure PMC_G_SetName
107	end INTERFACE PMC_G_SetName
108
109	INTERFACE PMC_G_GetName
110	MODULE procedure PMC_G_GetName
111	end INTERFACE PMC_G_GetName
112
113	INTERFACE PMC_sort
114	MODULE procedure sort_2d_i
115	end INTERFACE PMC_sort
116
117	PUBLIC PMC_G_SetName, PMC_G_GetName, PMC_sort
118
119
120	CONTAINS
121	SUBROUTINE PMC_G_SetName (myClient, couple_index, aName)
122	IMPLICIT none
123
124	TYPE(ClientDef),INTENT(INOUT) :: myClient
125	INTEGER,INTENT(IN) :: couple_index
126	CHARACTER(LEN=*) :: aName
127
128	INTEGER :: i
129	TYPE(ArrayDef),POINTER :: ar
130	TYPE(PeDef),POINTER :: aPE
131
132	do i=1,myClient%inter_npes
133	aPE => myClient%PEs(i)
134	ar => aPE%Arrays
135	if(.not. associated (ar) ) then
136	ar => DA_List_append (ar, couple_index)
137	aPE%ArrayStart => ar
138	else
139	ar => DA_List_append (ar, couple_index)
140	endif
141	Ar%Name = trim(aName) // " "
142	myClient%PEs(i)%Arrays => ar
143	end do
144
145	return
146	end SUBROUTINE PMC_G_SetName
147
148	SUBROUTINE PMC_G_GetName (myClient, couple_index, aName, aLast,Client_PeIndex)
149	IMPLICIT none
150
151	TYPE(ClientDef),INTENT(INOUT) :: myClient
152	INTEGER,INTENT(OUT) :: couple_index
153	CHARACTER(LEN=*),INTENT(OUT) :: aName
154	logical,INTENT(OUT) :: aLast
155	INTEGER,INTENT(IN),optional :: Client_PeIndex
156
157	INTEGER :: i,istart,istop
158	TYPE(PeDef),POINTER :: aPE
159	TYPE(ArrayDef),POINTER :: ar
160	logical,save :: first=.true.
161
162	aLast = .false.
163
164	if(present(Client_PeIndex)) then !Loop over all Client PEs or just one selected via Client_PeIndex
165	istart = Client_PeIndex
166	istop = Client_PeIndex
167	else
168	istart = 1
169	istop = myClient%inter_npes
170	end if
171
172	do i=istart,istop
173	aPE => myClient%PEs(i)
174	ar => aPE%Arrays
175	if(first) then
176	ar => aPE%ArrayStart
177	else
178	ar => aPE%Arrays
179	ar => DA_List_next (ar)
180	if(.not. associated (ar) ) then
181	aLast = .true.
182	first = .true. !Reset linked list to begin
183	aPE%Arrays => ar
184	end if
185	endif
186	aPE%Arrays => ar
187	end do
188	if(aLast) then
189	return
190	end if
191
192	couple_index = ar%coupleIndex
193	aName = ar%Name
194	aLast = .false.
195
196	first = .false.
197
198
199	return
200	END SUBROUTINE PMC_G_GetName
201
202	SUBROUTINE sort_2d_i (array,sort_ind)
203	IMPLICIT none
204	INTEGER,DIMENSION(:,:),INTENT(INOUT) :: array
205	INTEGER,INTENT(IN) :: sort_ind
206
207	!-- local Variables
208	INTEGER :: i,j,n
209	INTEGER,DIMENSION(size(array,1)) :: tmp
210
211	n = size(array,2)
212	do j=1,n-1
213	do i=j+1,n
214	if(array(sort_ind,i) < array(sort_ind,j) ) then
215	tmp = array(:,i)
216	array(:,i) = array(:,j)
217	array(:,j) = tmp
218	end if
219	end do
220	end do
221
222	return
223	END SUBROUTINE sort_2d_i
224
225	! Private section
226	! linked List routines for Data Array handling
227
228	FUNCTION DA_List_append (node, couple_index)
229	TYPE(ArrayDef),POINTER :: DA_List_append
230	TYPE(ArrayDef),POINTER :: node
231	INTEGER,INTENT(IN) :: couple_index
232
233	!-- local variables
234	TYPE(ArrayDef),POINTER :: ar
235
236	if(.not. associated (node)) then
237	ALLOCATE(ar)
238	ar%coupleIndex = couple_index
239	NULLIFY(ar%next)
240	DA_List_append => ar
241	else
242	ALLOCATE(node%next)
243	node%next%coupleIndex = couple_index
244	NULLIFY(node%next%next)
245	DA_List_append => node%next
246	end if
247
248	return
249	END FUNCTION DA_List_append
250
251	FUNCTION DA_List_next (node)
252	TYPE(ArrayDef),POINTER :: DA_List_next
253	TYPE(ArrayDef),POINTER :: node
254
255	DA_List_next => node%next
256
257	return
258	END FUNCTION DA_List_next
259
260	end MODULE pmc_general

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |