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

Last change on this file since 1762 was 1762, checked in by hellstea, 8 years ago

Introduction of nested domain system

  • Property svn:keywords set to Id
File size: 9.3 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! 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
258end MODULE pmc_general
Note: See TracBrowser for help on using the repository browser.