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

Last change on this file since 4016 was 3945, checked in by raasch, 6 years ago

messed document changes for r3932 cleaned up

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