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

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

re-formatting of remaining pmc routines

  • 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! re-formatted to match PALM style, file renamed again
23!
24! Former revisions:
25! -----------------
26! $Id: pmc_general_mod.f90 1900 2016-05-04 15:27:53Z 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
68    PRIVATE
69    SAVE
70
71    INTEGER, PARAMETER, PUBLIC :: da_desclen       =  8  !<
72    INTEGER, PARAMETER, PUBLIC :: da_namelen       = 16  !<
73    INTEGER, PARAMETER, PUBLIC :: pmc_da_name_err  = 10  !<
74    INTEGER, PARAMETER, PUBLIC :: pmc_max_array    = 32  !< max # of arrays which can be coupled
75    INTEGER, PARAMETER, PUBLIC :: pmc_max_models   = 64  !<
76    INTEGER, PARAMETER, PUBLIC :: pmc_status_ok    =  0  !<
77    INTEGER, PARAMETER, PUBLIC :: pmc_status_error = -1  !<
78
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,
91                                                 !< pmc_s_set_active_data_array
92                                                 !< sets active pointer
93       INTEGER(idp)              :: SendIndex    !< index in send buffer
94       INTEGER(idp)              :: RecvIndex    !< index in receive buffer
95       INTEGER                   :: SendSize     !< size in send buffer
96       INTEGER                   :: RecvSize     !< size in receive buffer
97       TYPE(C_PTR)               :: SendBuf      !< data pointer in send buffer
98       TYPE(C_PTR)               :: RecvBuf      !< data pointer in receive buffer
99       CHARACTER(LEN=8)          :: Name         !< name of array
100       TYPE(arraydef), POINTER   :: next
101    END TYPE arraydef
102
103    TYPE(arraydef), PUBLIC, POINTER  :: next
104
105    TYPE, PUBLIC ::  pedef
106       INTEGER :: nr_arrays = 0  !< number of arrays which will be transfered
107       INTEGER :: nrele          !< number of elements, same for all arrays
108       TYPE(xy_ind), POINTER, DIMENSION(:)   ::  locInd      !< xy index local array for remote PE
109       TYPE(arraydef), POINTER, DIMENSION(:) ::  array_list  !< list of data arrays to be transfered
110    END TYPE pedef
111
112    TYPE, PUBLIC ::  clientdef
113       INTEGER(idp) ::  totalbuffersize    !<
114       INTEGER      ::  model_comm         !< communicator of this model
115       INTEGER      ::  inter_comm         !< inter communicator model and client
116       INTEGER      ::  intra_comm         !< intra communicator model and client
117       INTEGER      ::  model_rank         !< rank of this model
118       INTEGER      ::  model_npes         !< number of PEs this model
119       INTEGER      ::  inter_npes         !< number of PEs client model
120       INTEGER      ::  intra_rank         !< rank within intra_comm
121       INTEGER      ::  win_server_client  !< MPI RMA for preparing data on server AND client side
122       TYPE(pedef), DIMENSION(:), POINTER ::  pes  !< list of all client PEs
123    END TYPE clientdef
124
125    TYPE, PUBLIC ::  da_namedef  !< data array name definition
126       INTEGER                   ::  couple_index  !< unique number of array
127       CHARACTER(LEN=da_desclen) ::  serverdesc    !< server array description
128       CHARACTER(LEN=da_namelen) ::  nameonserver  !< name of array within server
129       CHARACTER(LEN=da_desclen) ::  clientdesc    !< client array description
130       CHARACTER(LEN=da_namelen) ::  nameonclient  !< name of array within client
131    END TYPE da_namedef
132
133    INTERFACE pmc_g_setname
134       MODULE PROCEDURE pmc_g_setname
135    END INTERFACE pmc_g_setname
136
137    INTERFACE pmc_sort
138       MODULE PROCEDURE sort_2d_i
139    END INTERFACE pmc_sort
140
141    PUBLIC pmc_g_setname, pmc_sort
142
143 CONTAINS
144
145 SUBROUTINE pmc_g_setname( myclient, couple_index, aname )
146
147    IMPLICIT NONE
148
149    CHARACTER(LEN=*)               ::  aname         !<
150    INTEGER, INTENT(IN)            ::  couple_index  !<
151    TYPE(clientdef), INTENT(INOUT) ::  myclient      !<
152
153    INTEGER ::  i  !<
154
155    TYPE(arraydef), POINTER ::  ar   !<
156    TYPE(pedef), POINTER    ::  ape  !<
157
158!
159!-- Assign array to next free index in array list.
160!-- Set name of array in arraydef structure
161    DO  i = 1, myclient%inter_npes
162
163       ape => myclient%pes(i)
164       ape%nr_arrays = ape%nr_arrays + 1
165       ape%array_list(ape%nr_arrays)%name        = aname
166       ape%array_list(ape%nr_arrays)%coupleindex = couple_index
167
168    ENDDO
169
170 END SUBROUTINE pmc_g_setname
171
172
173
174 SUBROUTINE sort_2d_i( array, sort_ind )
175
176    IMPLICIT NONE
177
178    INTEGER, INTENT(IN)                    ::  sort_ind
179    INTEGER, DIMENSION(:,:), INTENT(INOUT) ::  array
180
181    INTEGER ::  i  !<
182    INTEGER ::  j  !<
183    INTEGER ::  n  !<
184
185    INTEGER, DIMENSION(SIZE(array,1)) ::  tmp  !<
186
187    n = SIZE(array,2)
188
189    DO  j = 1, n-1
190       DO  i = j+1, n
191
192          IF ( array(sort_ind,i) < array(sort_ind,j) )  THEN
193             tmp = array(:,i)
194             array(:,i) = array(:,j)
195             array(:,j) = tmp
196          ENDIF
197
198       ENDDO
199    ENDDO
200
201 END  SUBROUTINE sort_2d_i
202
203#endif
204 END MODULE pmc_general
Note: See TracBrowser for help on using the repository browser.