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

Last change on this file since 2699 was 2696, checked in by kanani, 7 years ago

Merge of branch palm4u into trunk

  • Property svn:keywords set to Id
File size: 7.2 KB
Line 
1 MODULE pmc_general
2
3!------------------------------------------------------------------------------!
4! This file is part of the PALM model system.
5!
6! PALM is free software: you can redistribute it and/or modify it under the
7! terms of the GNU General Public License as published by the Free Software
8! Foundation, either version 3 of the License, or (at your option) any later
9! version.
10!
11! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
12! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
13! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
14!
15! You should have received a copy of the GNU General Public License along with
16! PALM. If not, see <http://www.gnu.org/licenses/>.
17!
18! Copyright 1997-2017 Leibniz Universitaet Hannover
19!------------------------------------------------------------------------------!
20!
21! Current revisions:
22! ------------------
23!
24!
25! Former revisions:
26! -----------------
27! $Id: pmc_general_mod.f90 2696 2017-12-14 17:12:51Z kanani $
28! Some cleanup and commenting improvements only.
29!
30! 2101 2017-01-05 16:42:31Z suehring
31!
32! 2000 2016-08-20 18:09:15Z knoop
33! Forced header and separation lines into 80 columns
34!
35! 1901 2016-05-04 15:39:38Z raasch
36! Code clean up. The words server/client changed to parent/child.
37!
38! 1900 2016-05-04 15:27:53Z raasch
39! re-formatted to match PALM style, file renamed again
40!
41! 1808 2016-04-05 19:44:00Z raasch
42! MPI module used by default on all machines
43!
44! 1786 2016-03-08 05:49:27Z raasch
45! change in child-parent data transfer: parent now gets data from child
46! instead of that child puts it to the parent
47!
48! 1779 2016-03-03 08:01:28Z raasch
49! PMC_MPI_REAL removed, dim_order removed from type arraydef,
50! array management changed from linked list to sequential loop
51!
52! 1766 2016-02-29 08:37:15Z raasch
53! +po_data in type arraydef
54!
55! 1764 2016-02-28 12:45:19Z raasch
56! cpp-statement added (nesting can only be used in parallel mode),
57! all kinds given in PALM style
58!
59! 1762 2016-02-25 12:31:13Z hellstea
60! Initial revision by K. Ketelsen
61!
62! Description:
63! ------------
64!
65! Structure definition and utilities of Palm Model Coupler
66!------------------------------------------------------------------------------!
67
68#if defined( __parallel )
69    USE, INTRINSIC ::  ISO_C_BINDING
70
71    USE kinds
72
73#if defined( __mpifh )
74    INCLUDE "mpif.h"
75#else
76    USE MPI
77#endif
78
79    IMPLICIT NONE
80
81    PRIVATE
82    SAVE
83
84    INTEGER, PARAMETER, PUBLIC :: da_desclen       =  8  !<
85    INTEGER, PARAMETER, PUBLIC :: da_namelen       = 16  !<
86    INTEGER, PARAMETER, PUBLIC :: pmc_da_name_err  = 10  !<
87    INTEGER, PARAMETER, PUBLIC :: pmc_max_array    = 32  !< max # of arrays which can be coupled
88    INTEGER, PARAMETER, PUBLIC :: pmc_max_models   = 64  !<
89    INTEGER, PARAMETER, PUBLIC :: pmc_status_ok    =  0  !<
90    INTEGER, PARAMETER, PUBLIC :: pmc_status_error = -1  !<
91
92
93    TYPE, PUBLIC :: xy_ind  !< pair of indices in horizontal plane
94       INTEGER ::  i
95       INTEGER ::  j
96    END TYPE
97
98    TYPE, PUBLIC ::  arraydef
99       INTEGER                   :: coupleindex  !<
100       INTEGER                   :: nrdims       !< number of dimensions
101       INTEGER, DIMENSION(4)     :: a_dim        !< size of dimensions
102       TYPE(C_PTR)               :: data         !< pointer of data in parent space
103       TYPE(C_PTR), DIMENSION(2) :: po_data      !< base pointers,
104                                                 !< pmc_s_set_active_data_array
105                                                 !< sets active pointer
106       INTEGER(idp)              :: SendIndex    !< index in send buffer
107       INTEGER(idp)              :: RecvIndex    !< index in receive buffer
108       INTEGER                   :: SendSize     !< size in send buffer
109       INTEGER                   :: RecvSize     !< size in receive buffer
110       TYPE(C_PTR)               :: SendBuf      !< data pointer in send buffer
111       TYPE(C_PTR)               :: RecvBuf      !< data pointer in receive buffer
112       CHARACTER(LEN=8)          :: Name         !< name of array
113       TYPE(arraydef), POINTER   :: next
114    END TYPE arraydef
115
116    TYPE(arraydef), PUBLIC, POINTER  :: next
117
118    TYPE, PUBLIC ::  pedef
119       INTEGER :: nr_arrays = 0  !< number of arrays which will be transfered
120       INTEGER :: nrele          !< number of elements, same for all arrays
121       TYPE(xy_ind), POINTER, DIMENSION(:)   ::  locInd      !< xy index local array for remote PE
122       TYPE(arraydef), POINTER, DIMENSION(:) ::  array_list  !< list of data arrays to be transfered
123    END TYPE pedef
124
125    TYPE, PUBLIC ::  childdef
126       INTEGER(idp) ::  totalbuffersize    !<
127       INTEGER      ::  model_comm         !< communicator of this model
128       INTEGER      ::  inter_comm         !< inter communicator model and child
129       INTEGER      ::  intra_comm         !< intra communicator model and child
130       INTEGER      ::  model_rank         !< rank of this model
131       INTEGER      ::  model_npes         !< number of PEs this model
132       INTEGER      ::  inter_npes         !< number of PEs child model
133       INTEGER      ::  intra_rank         !< rank within intra_comm
134       INTEGER      ::  win_parent_child   !< MPI RMA for preparing data on parent AND child side
135       TYPE(pedef), DIMENSION(:), POINTER ::  pes  !< list of all child PEs
136    END TYPE childdef
137
138    TYPE, PUBLIC ::  da_namedef  !< data array name definition
139       INTEGER                   ::  couple_index  !< unique number of array
140       CHARACTER(LEN=da_desclen) ::  parentdesc    !< parent array description
141       CHARACTER(LEN=da_namelen) ::  nameonparent  !< name of array within parent
142       CHARACTER(LEN=da_desclen) ::  childdesc     !< child array description
143       CHARACTER(LEN=da_namelen) ::  nameonchild   !< name of array within child
144    END TYPE da_namedef
145
146    INTERFACE pmc_g_setname
147       MODULE PROCEDURE pmc_g_setname
148    END INTERFACE pmc_g_setname
149
150    INTERFACE pmc_sort
151       MODULE PROCEDURE sort_2d_i
152    END INTERFACE pmc_sort
153
154    PUBLIC pmc_g_setname, pmc_sort
155
156 CONTAINS
157
158
159   
160 SUBROUTINE pmc_g_setname( mychild, couple_index, aname )
161
162    IMPLICIT NONE
163
164    CHARACTER(LEN=*)               ::  aname         !<
165    INTEGER, INTENT(IN)            ::  couple_index  !<
166    TYPE(childdef), INTENT(INOUT)  ::  mychild       !<
167
168    INTEGER ::  i  !<
169
170    TYPE(arraydef), POINTER ::  ar   !<
171    TYPE(pedef), POINTER    ::  ape  !<
172
173!
174!-- Assign array to next free index in array list.
175!-- Set name of array in arraydef structure
176    DO  i = 1, mychild%inter_npes
177       ape => mychild%pes(i)
178       ape%nr_arrays = ape%nr_arrays + 1
179       ape%array_list(ape%nr_arrays)%name        = aname
180       ape%array_list(ape%nr_arrays)%coupleindex = couple_index
181    ENDDO
182
183 END SUBROUTINE pmc_g_setname
184
185
186
187 SUBROUTINE sort_2d_i( array, sort_ind )
188
189    IMPLICIT NONE
190
191    INTEGER, INTENT(IN)                    ::  sort_ind
192    INTEGER, DIMENSION(:,:), INTENT(INOUT) ::  array
193
194    INTEGER ::  i  !<
195    INTEGER ::  j  !<
196    INTEGER ::  n  !<
197
198    INTEGER, DIMENSION(SIZE(array,1)) ::  tmp  !<
199
200    n = SIZE(array,2)
201    DO  j = 1, n-1
202       DO  i = j+1, n
203          IF ( array(sort_ind,i) < array(sort_ind,j) )  THEN
204             tmp = array(:,i)
205             array(:,i) = array(:,j)
206             array(:,j) = tmp
207          ENDIF
208       ENDDO
209    ENDDO
210
211 END  SUBROUTINE sort_2d_i
212
213#endif
214 END MODULE pmc_general
Note: See TracBrowser for help on using the repository browser.