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

Last change on this file since 1933 was 1933, checked in by hellstea, 5 years ago

last commit documented

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