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

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

last commit documented

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