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

Last change on this file since 4631 was 4629, checked in by raasch, 4 years ago

support for MPI Fortran77 interface (mpif.h) removed

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