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

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

last commit documented

  • Property svn:keywords set to Id
File size: 9.5 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 1765 2016-02-28 13:30:40Z 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      INTEGER(idp)                  :: BufIndex                    ! index in Send Buffer
79      INTEGER                       :: BufSize                     ! size in Send Buffer
80      TYPE (c_ptr)                  :: SendBuf                     ! Pointer of Data in Send buffer
81      CHARACTER(len=8)              :: Name                        ! Name of Array
82
83      Type(ArrayDef),POINTER        :: next
84   END TYPE ArrayDef
85
86   TYPE (ArrayDef), PUBLIC, POINTER :: next;
87
88   TYPE, PUBLIC :: PeDef
89      INTEGER(idp)                        :: NrEle                 ! Number of Elemets
90      TYPE (xy_ind), POINTER,DIMENSION(:) :: locInd                ! xy index local array for remote PE
91      TYPE( ArrayDef), POINTER            :: Arrays                ! Pointer to Data Array List (Type ArrayDef)
92      TYPE( ArrayDef), POINTER            :: ArrayStart            ! Pointer to Star of the List
93   END TYPE PeDef
94
95   TYPE, PUBLIC :: ClientDef
96      INTEGER(idp)                  :: TotalBufferSize
97      INTEGER                       :: model_comm                  ! Communicator of this model
98      INTEGER                       :: inter_comm                  ! Inter communicator model and client
99      INTEGER                       :: intra_comm                  ! Intra communicator model and client
100      INTEGER                       :: model_rank                  ! Rank of this model
101      INTEGER                       :: model_npes                  ! Number of PEs this model
102      INTEGER                       :: inter_npes                  ! Number of PEs client model
103      INTEGER                       :: intra_rank                  ! rank within intra_comm
104      INTEGER                       :: BufWin                      ! MPI RMA windows
105      TYPE (PeDef), DIMENSION(:), POINTER      :: PEs              ! List of all Client PEs
106   END TYPE ClientDef
107
108   TYPE, PUBLIC    :: DA_NameDef                                   ! Data Array Name Definition
109      INTEGER                       :: couple_index                ! Unique Number of Array
110      CHARACTER(len=DA_Desclen)     :: ServerDesc                  ! Server array description
111      CHARACTER(len=DA_Namelen)     :: NameOnServer                ! Name of array within Server
112      CHARACTER(len=DA_Desclen)     :: ClientDesc                  ! Client array description
113      CHARACTER(len=DA_Namelen)     :: NameOnClient                ! Name of array within Client
114    END TYPE DA_NameDef
115
116    INTERFACE PMC_G_SetName
117       MODULE procedure PMC_G_SetName
118    end INTERFACE PMC_G_SetName
119
120    INTERFACE PMC_G_GetName
121       MODULE procedure PMC_G_GetName
122    end INTERFACE PMC_G_GetName
123
124    INTERFACE PMC_sort
125       MODULE procedure sort_2d_i
126    end INTERFACE PMC_sort
127
128    PUBLIC PMC_G_SetName, PMC_G_GetName, PMC_sort
129
130
131 CONTAINS
132    SUBROUTINE PMC_G_SetName (myClient, couple_index, aName)
133       IMPLICIT none
134
135       TYPE(ClientDef),INTENT(INOUT)           :: myClient
136       INTEGER,INTENT(IN)                      :: couple_index
137       CHARACTER(LEN=*)                        :: aName
138
139       INTEGER                                 :: i
140       TYPE(ArrayDef),POINTER                  :: ar
141       TYPE(PeDef),POINTER                     :: aPE
142
143       do i=1,myClient%inter_npes
144          aPE => myClient%PEs(i)
145          ar  => aPE%Arrays
146          if(.not. associated (ar) )  then
147             ar => DA_List_append (ar, couple_index)
148             aPE%ArrayStart => ar
149         else
150             ar => DA_List_append (ar, couple_index)
151           endif
152          Ar%Name    = trim(aName) // " "
153          myClient%PEs(i)%Arrays => ar
154       end do
155
156       return
157    end SUBROUTINE PMC_G_SetName
158
159    SUBROUTINE PMC_G_GetName (myClient, couple_index, aName, aLast,Client_PeIndex)
160       IMPLICIT none
161
162       TYPE(ClientDef),INTENT(INOUT)           :: myClient
163       INTEGER,INTENT(OUT)                     :: couple_index
164       CHARACTER(LEN=*),INTENT(OUT)            :: aName
165       logical,INTENT(OUT)                     :: aLast
166       INTEGER,INTENT(IN),optional             :: Client_PeIndex
167
168       INTEGER                                 :: i,istart,istop
169       TYPE(PeDef),POINTER                     :: aPE
170       TYPE(ArrayDef),POINTER                  :: ar
171       logical,save                            :: first=.true.
172
173       aLast = .false.
174
175       if(present(Client_PeIndex))  then       !Loop over all Client PEs or just one selected via Client_PeIndex
176          istart = Client_PeIndex
177          istop  = Client_PeIndex
178       else
179          istart = 1
180          istop  = myClient%inter_npes
181       end if
182
183       do i=istart,istop
184          aPE => myClient%PEs(i)
185          ar  => aPE%Arrays
186          if(first)  then
187             ar => aPE%ArrayStart
188          else
189             ar => aPE%Arrays
190             ar => DA_List_next (ar)
191             if(.not. associated (ar) )  then
192                aLast = .true.
193                first = .true.                                  !Reset linked list to begin
194                aPE%Arrays => ar
195              end if
196          endif
197          aPE%Arrays => ar
198       end do
199       if(aLast) then
200          return
201       end if
202
203       couple_index = ar%coupleIndex
204       aName        = ar%Name
205       aLast        = .false.
206
207       first = .false.
208
209
210       return
211    END SUBROUTINE PMC_G_GetName
212
213    SUBROUTINE sort_2d_i (array,sort_ind)
214       IMPLICIT none
215       INTEGER,DIMENSION(:,:),INTENT(INOUT)         :: array
216       INTEGER,INTENT(IN)                           :: sort_ind
217
218       !-- local Variables
219       INTEGER      :: i,j,n
220       INTEGER,DIMENSION(size(array,1))             :: tmp
221
222       n = size(array,2)
223       do j=1,n-1
224          do i=j+1,n
225             if(array(sort_ind,i) < array(sort_ind,j) )  then
226                tmp = array(:,i)
227                array(:,i) = array(:,j)
228                array(:,j) = tmp
229             end if
230          end do
231       end do
232
233       return
234    END  SUBROUTINE sort_2d_i
235
236!   Private section
237!   linked List routines for Data Array handling
238
239    FUNCTION DA_List_append   (node, couple_index)
240       TYPE(ArrayDef),POINTER      :: DA_List_append
241       TYPE(ArrayDef),POINTER      :: node
242       INTEGER,INTENT(IN)          :: couple_index
243
244!--    local variables
245       TYPE(ArrayDef),POINTER      :: ar
246
247       if(.not. associated (node))   then
248          ALLOCATE(ar)
249          ar%coupleIndex = couple_index
250          NULLIFY(ar%next)
251          DA_List_append => ar
252       else
253          ALLOCATE(node%next)
254          node%next%coupleIndex = couple_index
255          NULLIFY(node%next%next)
256          DA_List_append => node%next
257       end if
258
259       return
260    END FUNCTION DA_List_append
261
262    FUNCTION DA_List_next   (node)
263       TYPE(ArrayDef),POINTER      :: DA_List_next
264       TYPE(ArrayDef),POINTER      :: node
265
266       DA_List_next => node%next
267
268       return
269    END FUNCTION DA_List_next
270
271#endif
272end MODULE pmc_general
Note: See TracBrowser for help on using the repository browser.