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

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

update of the nested domain system + some bugfixes

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