Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |