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

Last change on this file since 1842 was 1818, checked in by maronga, 8 years ago

last commit documented / copyright update

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