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

Last change on this file since 3943 was 3943, checked in by maronga, 2 years ago

bugfixes in urban surface model; output of greenz roof transpiration added/corrected; minor formatting improvements

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