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

Last change on this file since 1763 was 1763, checked in by hellstea, 6 years ago

last commit documented

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