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

Last change on this file since 2053 was 2001, checked in by knoop, 8 years ago

last commit documented

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