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

Last change on this file since 1766 was 1766, checked in by raasch, 6 years ago

pmc now runs with pointer version too

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