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

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

last commit documented

  • Property svn:keywords set to Id
File size: 7.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 1787 2016-03-08 06:57:00Z raasch $
27!
28! 1786 2016-03-08 05:49:27Z raasch
29! change in client-server data transfer: server now gets data from client
30! instead that client put's it to the server
31!
32! 1779 2016-03-03 08:01:28Z raasch
33! PMC_MPI_REAL removed, dim_order removed from type arraydef,
34! array management changed from linked list to sequential loop
35!
36! 1766 2016-02-29 08:37:15Z raasch
37! +po_data in type arraydef
38!
39! 1764 2016-02-28 12:45:19Z raasch
40! cpp-statement added (nesting can only be used in parallel mode),
41! all kinds given in PALM style
42!
43! 1762 2016-02-25 12:31:13Z hellstea
44! Initial revision by K. Ketelsen
45!
46! Description:
47! ------------
48!
49! Structure definition and utilities of Palm Model Coupler
50!------------------------------------------------------------------------------!
51
52#if defined( __parallel )
53   use, intrinsic :: iso_c_binding
54
55   USE kinds
56
57#if defined( __lc )
58    USE MPI
59#else
60    INCLUDE "mpif.h"
61#endif
62
63   IMPLICIT none
64   PRIVATE
65   SAVE
66
67! return status
68   INTEGER,parameter,PUBLIC              :: PMC_STATUS_OK    = 0
69   INTEGER,parameter,PUBLIC              :: PMC_STATUS_ERROR = -1
70   INTEGER,parameter,PUBLIC              :: PMC_DA_NAME_ERR  = 10
71
72   INTEGER,parameter,PUBLIC              :: PMC_MAX_ARRAY    = 32  !Max Number of Array which can be coupled
73   INTEGER,parameter,PUBLIC              :: PMC_MAX_MODELL   = 64
74   INTEGER,parameter,PUBLIC              :: DA_Desclen       = 8
75   INTEGER,parameter,PUBLIC              :: DA_Namelen       = 16
76
77   TYPE, PUBLIC :: xy_ind                                          ! Pair of indices in horizontal plane
78      INTEGER                       ::  i
79      INTEGER                       ::  j
80   END TYPE
81
82   TYPE, PUBLIC :: ArrayDef
83      INTEGER                       :: coupleIndex
84      INTEGER                       :: NrDims                      ! Number of Dimensions
85      INTEGER,DIMENSION(4)          :: A_dim                       ! Size of dimensions
86      TYPE(c_ptr)                   :: data                        ! Pointer of data in server space
87      TYPE(c_ptr), DIMENSION(2)     :: po_data                     ! Base Pointers, PMC_S_Set_Active_data_array sets active pointer
88      INTEGER(idp)                  :: SendIndex                   ! index in Send Buffer
89      INTEGER(idp)                  :: RecvIndex                   ! index in Receive Buffer
90      INTEGER                       :: SendSize                    ! size in Send Buffer
91      INTEGER                       :: RecvSize                    ! size in Receiver Buffer
92      TYPE (c_ptr)                  :: SendBuf                     ! Pointer of Data in Send buffer
93      TYPE (c_ptr)                  :: RecvBuf                     ! Pointer of Data in ReceiveS buffer
94      CHARACTER(len=8)              :: Name                        ! Name of Array
95
96      Type(ArrayDef),POINTER        :: next
97   END TYPE ArrayDef
98
99   TYPE (ArrayDef), PUBLIC, POINTER :: next;
100
101   TYPE, PUBLIC :: PeDef
102      INTEGER                                :: Nr_arrays=0        ! Number of arrays which will be transfered in this run
103      INTEGER                                :: NrEle              ! Number of Elemets, same for all arrays
104      TYPE (xy_ind), POINTER,DIMENSION(:)    :: locInd             ! xy index local array for remote PE
105      TYPE( ArrayDef), POINTER, DIMENSION(:) :: array_list         ! List of Data Arrays to be transfered
106   END TYPE PeDef
107
108   TYPE, PUBLIC :: ClientDef
109      INTEGER(idp)                  :: TotalBufferSize
110      INTEGER                       :: model_comm                  ! Communicator of this model
111      INTEGER                       :: inter_comm                  ! Inter communicator model and client
112      INTEGER                       :: intra_comm                  ! Intra communicator model and client
113      INTEGER                       :: model_rank                  ! Rank of this model
114      INTEGER                       :: model_npes                  ! Number of PEs this model
115      INTEGER                       :: inter_npes                  ! Number of PEs client model
116      INTEGER                       :: intra_rank                  ! rank within intra_comm
117      INTEGER                       :: win_server_client           ! MPI RMA for preparing data on server AND client side
118      TYPE (PeDef), DIMENSION(:), POINTER      :: PEs              ! List of all Client PEs
119   END TYPE ClientDef
120
121   TYPE, PUBLIC    :: DA_NameDef                                   ! Data Array Name Definition
122      INTEGER                       :: couple_index                ! Unique Number of Array
123      CHARACTER(len=DA_Desclen)     :: ServerDesc                  ! Server array description
124      CHARACTER(len=DA_Namelen)     :: NameOnServer                ! Name of array within Server
125      CHARACTER(len=DA_Desclen)     :: ClientDesc                  ! Client array description
126      CHARACTER(len=DA_Namelen)     :: NameOnClient                ! Name of array within Client
127    END TYPE DA_NameDef
128
129    INTERFACE PMC_G_SetName
130       MODULE procedure PMC_G_SetName
131    end INTERFACE PMC_G_SetName
132
133    INTERFACE PMC_sort
134       MODULE procedure sort_2d_i
135    end INTERFACE PMC_sort
136
137    PUBLIC PMC_G_SetName, PMC_sort
138
139
140 CONTAINS
141    SUBROUTINE PMC_G_SetName (myClient, couple_index, aName)
142       IMPLICIT none
143
144       TYPE(ClientDef),INTENT(INOUT)           :: myClient
145       INTEGER,INTENT(IN)                      :: couple_index
146       CHARACTER(LEN=*)                        :: aName
147
148       INTEGER                                 :: i
149       TYPE(ArrayDef),POINTER                  :: ar
150       TYPE(PeDef),POINTER                     :: aPE
151
152!
153!--    Assign array to next free index in array_list.
154!--    Set name of array in ArrayDef structure
155       do i=1,myClient%inter_npes
156          aPE => myClient%PEs(i)
157          aPE%Nr_arrays = aPE%Nr_arrays+1
158          aPE%array_list(aPE%Nr_arrays)%name        = aName
159          aPE%array_list(aPE%Nr_arrays)%coupleIndex = couple_index
160       end do
161
162       return
163    end SUBROUTINE PMC_G_SetName
164
165
166    SUBROUTINE sort_2d_i (array,sort_ind)
167       IMPLICIT none
168       INTEGER,DIMENSION(:,:),INTENT(INOUT)         :: array
169       INTEGER,INTENT(IN)                           :: sort_ind
170
171       !-- local Variables
172       INTEGER      :: i,j,n
173       INTEGER,DIMENSION(size(array,1))             :: tmp
174
175       n = size(array,2)
176       do j=1,n-1
177          do i=j+1,n
178             if(array(sort_ind,i) < array(sort_ind,j) )  then
179                tmp = array(:,i)
180                array(:,i) = array(:,j)
181                array(:,j) = tmp
182             end if
183          end do
184       end do
185
186       return
187    END  SUBROUTINE sort_2d_i
188
189#endif
190end MODULE pmc_general
Note: See TracBrowser for help on using the repository browser.