source: palm/trunk/SOURCE/pmc_general_mod.f90 @ 1901

Last change on this file since 1901 was 1901, checked in by raasch, 5 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 6.9 KB
Line 
1 MODULE 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_mod.f90 1901 2016-05-04 15:39:38Z raasch $
27!
28! 1900 2016-05-04 15:27:53Z raasch
29! re-formatted to match PALM style, file renamed again
30!
31! 1808 2016-04-05 19:44:00Z raasch
32! MPI module used by default on all machines
33!
34! 1786 2016-03-08 05:49:27Z raasch
35! change in client-server data transfer: server now gets data from client
36! instead that client put's it to the server
37!
38! 1779 2016-03-03 08:01:28Z raasch
39! PMC_MPI_REAL removed, dim_order removed from type arraydef,
40! array management changed from linked list to sequential loop
41!
42! 1766 2016-02-29 08:37:15Z raasch
43! +po_data in type arraydef
44!
45! 1764 2016-02-28 12:45:19Z raasch
46! cpp-statement added (nesting can only be used in parallel mode),
47! all kinds given in PALM style
48!
49! 1762 2016-02-25 12:31:13Z hellstea
50! Initial revision by K. Ketelsen
51!
52! Description:
53! ------------
54!
55! Structure definition and utilities of Palm Model Coupler
56!------------------------------------------------------------------------------!
57
58#if defined( __parallel )
59    USE, INTRINSIC ::  ISO_C_BINDING
60
61    USE kinds
62
63#if defined( __mpifh )
64    INCLUDE "mpif.h"
65#else
66    USE MPI
67#endif
68
69    IMPLICIT NONE
70
71    PRIVATE
72    SAVE
73
74    INTEGER, PARAMETER, PUBLIC :: da_desclen       =  8  !<
75    INTEGER, PARAMETER, PUBLIC :: da_namelen       = 16  !<
76    INTEGER, PARAMETER, PUBLIC :: pmc_da_name_err  = 10  !<
77    INTEGER, PARAMETER, PUBLIC :: pmc_max_array    = 32  !< max # of arrays which can be coupled
78    INTEGER, PARAMETER, PUBLIC :: pmc_max_models   = 64  !<
79    INTEGER, PARAMETER, PUBLIC :: pmc_status_ok    =  0  !<
80    INTEGER, PARAMETER, PUBLIC :: pmc_status_error = -1  !<
81
82
83    TYPE, PUBLIC :: xy_ind  !< pair of indices in horizontal plane
84       INTEGER ::  i
85       INTEGER ::  j
86    END TYPE
87
88    TYPE, PUBLIC ::  arraydef
89       INTEGER                   :: coupleindex  !<
90       INTEGER                   :: nrdims       !< number of dimensions
91       INTEGER, DIMENSION(4)     :: a_dim        !< size of dimensions
92       TYPE(C_PTR)               :: data         !< pointer of data in server space
93       TYPE(C_PTR), DIMENSION(2) :: po_data      !< base pointers,
94                                                 !< pmc_s_set_active_data_array
95                                                 !< sets active pointer
96       INTEGER(idp)              :: SendIndex    !< index in send buffer
97       INTEGER(idp)              :: RecvIndex    !< index in receive buffer
98       INTEGER                   :: SendSize     !< size in send buffer
99       INTEGER                   :: RecvSize     !< size in receive buffer
100       TYPE(C_PTR)               :: SendBuf      !< data pointer in send buffer
101       TYPE(C_PTR)               :: RecvBuf      !< data pointer in receive buffer
102       CHARACTER(LEN=8)          :: Name         !< name of array
103       TYPE(arraydef), POINTER   :: next
104    END TYPE arraydef
105
106    TYPE(arraydef), PUBLIC, POINTER  :: next
107
108    TYPE, PUBLIC ::  pedef
109       INTEGER :: nr_arrays = 0  !< number of arrays which will be transfered
110       INTEGER :: nrele          !< number of elements, same for all arrays
111       TYPE(xy_ind), POINTER, DIMENSION(:)   ::  locInd      !< xy index local array for remote PE
112       TYPE(arraydef), POINTER, DIMENSION(:) ::  array_list  !< list of data arrays to be transfered
113    END TYPE pedef
114
115    TYPE, PUBLIC ::  clientdef
116       INTEGER(idp) ::  totalbuffersize    !<
117       INTEGER      ::  model_comm         !< communicator of this model
118       INTEGER      ::  inter_comm         !< inter communicator model and client
119       INTEGER      ::  intra_comm         !< intra communicator model and client
120       INTEGER      ::  model_rank         !< rank of this model
121       INTEGER      ::  model_npes         !< number of PEs this model
122       INTEGER      ::  inter_npes         !< number of PEs client model
123       INTEGER      ::  intra_rank         !< rank within intra_comm
124       INTEGER      ::  win_server_client  !< MPI RMA for preparing data on server AND client side
125       TYPE(pedef), DIMENSION(:), POINTER ::  pes  !< list of all client PEs
126    END TYPE clientdef
127
128    TYPE, PUBLIC ::  da_namedef  !< data array name definition
129       INTEGER                   ::  couple_index  !< unique number of array
130       CHARACTER(LEN=da_desclen) ::  serverdesc    !< server array description
131       CHARACTER(LEN=da_namelen) ::  nameonserver  !< name of array within server
132       CHARACTER(LEN=da_desclen) ::  clientdesc    !< client array description
133       CHARACTER(LEN=da_namelen) ::  nameonclient  !< name of array within client
134    END TYPE da_namedef
135
136    INTERFACE pmc_g_setname
137       MODULE PROCEDURE pmc_g_setname
138    END INTERFACE pmc_g_setname
139
140    INTERFACE pmc_sort
141       MODULE PROCEDURE sort_2d_i
142    END INTERFACE pmc_sort
143
144    PUBLIC pmc_g_setname, pmc_sort
145
146 CONTAINS
147
148 SUBROUTINE pmc_g_setname( myclient, couple_index, aname )
149
150    IMPLICIT NONE
151
152    CHARACTER(LEN=*)               ::  aname         !<
153    INTEGER, INTENT(IN)            ::  couple_index  !<
154    TYPE(clientdef), INTENT(INOUT) ::  myclient      !<
155
156    INTEGER ::  i  !<
157
158    TYPE(arraydef), POINTER ::  ar   !<
159    TYPE(pedef), POINTER    ::  ape  !<
160
161!
162!-- Assign array to next free index in array list.
163!-- Set name of array in arraydef structure
164    DO  i = 1, myclient%inter_npes
165
166       ape => myclient%pes(i)
167       ape%nr_arrays = ape%nr_arrays + 1
168       ape%array_list(ape%nr_arrays)%name        = aname
169       ape%array_list(ape%nr_arrays)%coupleindex = couple_index
170
171    ENDDO
172
173 END SUBROUTINE pmc_g_setname
174
175
176
177 SUBROUTINE sort_2d_i( array, sort_ind )
178
179    IMPLICIT NONE
180
181    INTEGER, INTENT(IN)                    ::  sort_ind
182    INTEGER, DIMENSION(:,:), INTENT(INOUT) ::  array
183
184    INTEGER ::  i  !<
185    INTEGER ::  j  !<
186    INTEGER ::  n  !<
187
188    INTEGER, DIMENSION(SIZE(array,1)) ::  tmp  !<
189
190    n = SIZE(array,2)
191
192    DO  j = 1, n-1
193       DO  i = j+1, n
194
195          IF ( array(sort_ind,i) < array(sort_ind,j) )  THEN
196             tmp = array(:,i)
197             array(:,i) = array(:,j)
198             array(:,j) = tmp
199          ENDIF
200
201       ENDDO
202    ENDDO
203
204 END  SUBROUTINE sort_2d_i
205
206#endif
207 END MODULE pmc_general
Note: See TracBrowser for help on using the repository browser.