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

Last change on this file since 4782 was 4649, checked in by raasch, 4 years ago

files re-formatted to follow the PALM coding standard

  • Property svn:keywords set to Id
File size: 7.3 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 terms of the GNU General
7! Public License as published by the Free Software Foundation, either version 3 of the License, or
8! (at your option) any later version.
9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
11! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
12! Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with PALM. If not, see
15! <http://www.gnu.org/licenses/>.
16!
17! Copyright 1997-2020 Leibniz Universitaet Hannover
18!--------------------------------------------------------------------------------------------------!
19!
20!
21! Current revisions:
22! -----------------
23!
24!
25! Former revisions:
26! -----------------
27! $Id: pmc_general_mod.f90 4649 2020-08-25 12:11:17Z gronemeier $
28! File re-formatted to follow the PALM coding standard
29!
30! 4629 2020-07-29 09:37:56Z raasch
31! Support for MPI Fortran77 interface (mpif.h) removed
32!
33! 4360 2020-01-07 11:25:50Z suehring
34! Corrected "Former revisions" section
35!
36! 3945 2019-05-02 11:29:27Z raasch
37!
38! 2019-04-24 17:31:34Z suehring
39! Increase character length so that also chemistry variable names fully fit
40!
41! 3655 2019-01-07 16:51:22Z knoop
42! Determine number of coupled arrays dynamically.
43!
44! 1762 2016-02-25 12:31:13Z hellstea
45! Initial revision by K. Ketelsen
46!
47! Description:
48! ------------
49!
50! Structure definition and utilities of Palm Model Coupler
51!--------------------------------------------------------------------------------------------------!
52
53#if defined( __parallel )
54    USE, INTRINSIC ::  ISO_C_BINDING
55
56    USE kinds
57
58    USE MPI
59
60    IMPLICIT NONE
61
62
63    PRIVATE
64    SAVE
65
66    INTEGER(iwp), PARAMETER, PUBLIC :: da_desclen       =  8  !<
67    INTEGER(iwp), PARAMETER, PUBLIC :: da_namelen       = 16  !<
68    INTEGER(iwp), PARAMETER, PUBLIC :: pmc_da_name_err  = 10  !<
69    INTEGER(iwp), PARAMETER, PUBLIC :: pmc_max_models   = 64  !<
70    INTEGER(iwp), PARAMETER, PUBLIC :: pmc_status_ok    =  0  !<
71    INTEGER(iwp), PARAMETER, PUBLIC :: pmc_status_error = -1  !<
72
73    INTEGER(iwp), PUBLIC ::  pmc_max_array  !< max # of arrays which can be coupled
74                                            !< - will be determined dynamically in pmc_interface
75
76
77    TYPE, PUBLIC :: xy_ind  !< pair of indices in horizontal plane
78       INTEGER(iwp) ::  i
79       INTEGER(iwp) ::  j
80    END TYPE
81
82    TYPE, PUBLIC ::  arraydef
83       CHARACTER(LEN=da_namelen) ::  Name  !< name of array
84
85       INTEGER(iwp) ::  coupleindex  !<
86       INTEGER(iwp) ::  dimkey       !< key for NR dimensions and array type
87       INTEGER(iwp) ::  nrdims       !< number of dimensions
88       INTEGER(iwp) ::  RecvSize     !< size in receive buffer
89       INTEGER(iwp) ::  SendSize     !< size in send buffer
90
91       INTEGER(idp) ::  RecvIndex  !< index in receive buffer
92       INTEGER(idp) ::  SendIndex  !< index in send buffer
93
94       INTEGER(iwp), DIMENSION(4) ::  a_dim  !< size of dimensions
95
96       TYPE(C_PTR) ::  data     !< pointer of data in parent space
97       TYPE(C_PTR) ::  SendBuf  !< data pointer in send buffer
98       TYPE(C_PTR) ::  RecvBuf  !< data pointer in receive buffer
99
100       TYPE(arraydef), POINTER ::  next  !<
101
102       TYPE(C_PTR), DIMENSION(2) ::  po_data  !< base pointers, pmc_s_set_active_data_array
103                                              !< sets active pointer
104    END TYPE arraydef
105
106
107    TYPE(arraydef), PUBLIC, POINTER  :: next  !<
108
109
110    TYPE, PUBLIC ::  pedef
111       INTEGER(iwp) :: nr_arrays = 0  !< number of arrays which will be transfered
112       INTEGER(iwp) :: nrele          !< number of elements, same for all arrays
113
114       TYPE(arraydef), POINTER, DIMENSION(:) ::  array_list  !< list of data arrays to be transfered
115       TYPE(xy_ind), POINTER, DIMENSION(:)   ::  locInd      !< xy index local array for remote PE
116    END TYPE pedef
117
118
119    TYPE, PUBLIC ::  childdef
120       INTEGER(iwp) ::  inter_comm         !< inter communicator model and child
121       INTEGER(iwp) ::  inter_npes         !< number of PEs child model
122       INTEGER(iwp) ::  intra_comm         !< intra communicator model and child
123       INTEGER(iwp) ::  intra_rank         !< rank within intra_comm
124       INTEGER(iwp) ::  model_comm         !< communicator of this model
125       INTEGER(iwp) ::  model_npes         !< number of PEs this model
126       INTEGER(iwp) ::  model_rank         !< rank of this model
127       INTEGER(idp) ::  totalbuffersize    !<
128       INTEGER(iwp) ::  win_parent_child   !< MPI RMA for preparing data on parent AND child side
129       TYPE(pedef), DIMENSION(:), POINTER ::  pes  !< list of all child PEs
130    END TYPE childdef
131
132
133    TYPE, PUBLIC ::  da_namedef  !< data array name definition
134       CHARACTER(LEN=da_desclen) ::  childdesc     !< child array description
135       CHARACTER(LEN=da_namelen) ::  nameonchild   !< name of array within child
136       CHARACTER(LEN=da_namelen) ::  nameonparent  !< name of array within parent
137       CHARACTER(LEN=da_desclen) ::  parentdesc    !< parent array description
138       INTEGER(iwp)              ::  couple_index  !< unique number of array
139    END TYPE da_namedef
140
141    INTERFACE pmc_g_setname
142       MODULE PROCEDURE pmc_g_setname
143    END INTERFACE pmc_g_setname
144
145    INTERFACE pmc_sort
146       MODULE PROCEDURE sort_2d_i
147    END INTERFACE pmc_sort
148
149    PUBLIC pmc_g_setname, pmc_sort
150
151 CONTAINS
152
153!--------------------------------------------------------------------------------------------------!
154! Description:
155! ------------
156!> @Todo: Missing subroutine description.
157!--------------------------------------------------------------------------------------------------!
158 SUBROUTINE pmc_g_setname( mychild, couple_index, aname )
159
160    IMPLICIT NONE
161
162    CHARACTER(LEN=*)              ::  aname         !<
163
164    INTEGER(iwp), INTENT(IN)      ::  couple_index  !<
165
166    INTEGER(iwp) ::  i  !<
167
168    TYPE(childdef), INTENT(INOUT) ::  mychild       !<
169
170    TYPE(pedef), POINTER    ::  ape  !<
171
172!
173!-- Assign array to next free index in array list.
174!-- Set name of array in arraydef structure
175    DO  i = 1, mychild%inter_npes
176       ape => mychild%pes(i)
177       ape%nr_arrays = ape%nr_arrays + 1
178       ape%array_list(ape%nr_arrays)%name        = aname
179       ape%array_list(ape%nr_arrays)%coupleindex = couple_index
180    ENDDO
181
182 END SUBROUTINE pmc_g_setname
183
184
185!--------------------------------------------------------------------------------------------------!
186! Description:
187! ------------
188!> @Todo: Missing subroutine description.
189!--------------------------------------------------------------------------------------------------!
190 SUBROUTINE sort_2d_i( array, sort_ind )
191
192    IMPLICIT NONE
193
194    INTEGER(iwp), INTENT(IN)                    ::  sort_ind
195    INTEGER(iwp), DIMENSION(:,:), INTENT(INOUT) ::  array
196
197    INTEGER(iwp) ::  i  !<
198    INTEGER(iwp) ::  j  !<
199    INTEGER(iwp) ::  n  !<
200
201    INTEGER(iwp), DIMENSION(SIZE(array,1)) ::  tmp  !<
202
203    n = SIZE( array, 2 )
204    DO  j = 1, n-1
205       DO  i = j+1, n
206          IF ( array(sort_ind,i) < array(sort_ind,j) )  THEN
207             tmp = array(:,i)
208             array(:,i) = array(:,j)
209             array(:,j) = tmp
210          ENDIF
211       ENDDO
212    ENDDO
213
214 END  SUBROUTINE sort_2d_i
215
216#endif
217 END MODULE pmc_general
Note: See TracBrowser for help on using the repository browser.