source: palm/trunk/SOURCE/pmc_general.f90 @ 1780

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

last commit documented

  • Property svn:keywords set to Id
File size: 7.0 KB
Line 
1MODULE pmc_general
2
3!--------------------------------------------------------------------------------!
4! This file is part of PALM.
5!
6! PALM is free software: you can redistribute it and/or modify it under the terms
7! of the GNU General Public License as published by the Free Software Foundation,
8! either version 3 of the License, or (at your option) any later version.
9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
17! Copyright 1997-2015 Leibniz Universitaet Hannover
18!--------------------------------------------------------------------------------!
19!
20! Current revisions:
21! ------------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: pmc_general.f90 1780 2016-03-03 08:39:40Z raasch $
27!
28! 1779 2016-03-03 08:01:28Z raasch
29! PMC_MPI_REAL removed, dim_order removed from type arraydef,
30! array management changed from linked list to sequential loop
31!
32! 1766 2016-02-29 08:37:15Z raasch
33! +po_data in type arraydef
34!
35! 1764 2016-02-28 12:45:19Z raasch
36! cpp-statement added (nesting can only be used in parallel mode),
37! all kinds given in PALM style
38!
39! 1762 2016-02-25 12:31:13Z hellstea
40! Initial revision by K. Ketelsen
41!
42! Description:
43! ------------
44!
45! Structure definition and utilities of Palm Model Coupler
46!------------------------------------------------------------------------------!
47
48#if defined( __parallel )
49   use, intrinsic :: iso_c_binding
50
51   USE kinds
52
53#if defined( __lc )
54    USE MPI
55#else
56    INCLUDE "mpif.h"
57#endif
58
59   IMPLICIT none
60   PRIVATE
61   SAVE
62
63! return status
64   INTEGER,parameter,PUBLIC              :: PMC_STATUS_OK    = 0
65   INTEGER,parameter,PUBLIC              :: PMC_STATUS_ERROR = -1
66   INTEGER,parameter,PUBLIC              :: PMC_DA_NAME_ERR  = 10
67
68   INTEGER,parameter,PUBLIC              :: PMC_MAX_ARRAY    = 32  !Max Number of Array which can be coupled
69   INTEGER,parameter,PUBLIC              :: PMC_MAX_MODELL   = 64
70   INTEGER,parameter,PUBLIC              :: DA_Desclen       = 8
71   INTEGER,parameter,PUBLIC              :: DA_Namelen       = 16
72
73   TYPE, PUBLIC :: xy_ind                                          ! Pair of indices in horizontal plane
74      INTEGER                       ::  i
75      INTEGER                       ::  j
76   END TYPE
77
78   TYPE, PUBLIC :: ArrayDef
79      INTEGER                       :: coupleIndex
80      INTEGER                       :: NrDims                      ! Number of Dimensions
81      INTEGER,DIMENSION(4)          :: A_dim                       ! Size of dimensions
82      TYPE(c_ptr)                   :: data                        ! Pointer of data in server space
83      TYPE(c_ptr), DIMENSION(2)     :: po_data                     ! Base Pointers, PMC_S_Set_Active_data_array sets active pointer
84      INTEGER(idp)                  :: BufIndex                    ! index in Send Buffer
85      INTEGER                       :: BufSize                     ! size in Send Buffer
86      TYPE (c_ptr)                  :: SendBuf                     ! Pointer of Data in Send buffer
87      CHARACTER(len=8)              :: Name                        ! Name of Array
88
89      Type(ArrayDef),POINTER        :: next
90   END TYPE ArrayDef
91
92   TYPE (ArrayDef), PUBLIC, POINTER :: next;
93
94   TYPE, PUBLIC :: PeDef
95      INTEGER                                :: Nr_arrays=0        ! Number of arrays which will be transfered in this run
96      INTEGER                                :: NrEle              ! Number of Elemets, same for all arrays
97      TYPE (xy_ind), POINTER,DIMENSION(:)    :: locInd             ! xy index local array for remote PE
98      TYPE( ArrayDef), POINTER, DIMENSION(:) :: array_list         ! List of Data Arrays to be transfered
99   END TYPE PeDef
100
101   TYPE, PUBLIC :: ClientDef
102      INTEGER(idp)                  :: TotalBufferSize
103      INTEGER                       :: model_comm                  ! Communicator of this model
104      INTEGER                       :: inter_comm                  ! Inter communicator model and client
105      INTEGER                       :: intra_comm                  ! Intra communicator model and client
106      INTEGER                       :: model_rank                  ! Rank of this model
107      INTEGER                       :: model_npes                  ! Number of PEs this model
108      INTEGER                       :: inter_npes                  ! Number of PEs client model
109      INTEGER                       :: intra_rank                  ! rank within intra_comm
110      INTEGER                       :: BufWin                      ! MPI RMA windows
111      TYPE (PeDef), DIMENSION(:), POINTER      :: PEs              ! List of all Client PEs
112   END TYPE ClientDef
113
114   TYPE, PUBLIC    :: DA_NameDef                                   ! Data Array Name Definition
115      INTEGER                       :: couple_index                ! Unique Number of Array
116      CHARACTER(len=DA_Desclen)     :: ServerDesc                  ! Server array description
117      CHARACTER(len=DA_Namelen)     :: NameOnServer                ! Name of array within Server
118      CHARACTER(len=DA_Desclen)     :: ClientDesc                  ! Client array description
119      CHARACTER(len=DA_Namelen)     :: NameOnClient                ! Name of array within Client
120    END TYPE DA_NameDef
121
122    INTERFACE PMC_G_SetName
123       MODULE procedure PMC_G_SetName
124    end INTERFACE PMC_G_SetName
125
126    INTERFACE PMC_sort
127       MODULE procedure sort_2d_i
128    end INTERFACE PMC_sort
129
130    PUBLIC PMC_G_SetName, PMC_sort
131
132
133 CONTAINS
134    SUBROUTINE PMC_G_SetName (myClient, couple_index, aName)
135       IMPLICIT none
136
137       TYPE(ClientDef),INTENT(INOUT)           :: myClient
138       INTEGER,INTENT(IN)                      :: couple_index
139       CHARACTER(LEN=*)                        :: aName
140
141       INTEGER                                 :: i
142       TYPE(ArrayDef),POINTER                  :: ar
143       TYPE(PeDef),POINTER                     :: aPE
144
145!
146!--    Assign array to next free index in array_list.
147!--    Set name of array in ArrayDef structure
148       do i=1,myClient%inter_npes
149          aPE => myClient%PEs(i)
150          aPE%Nr_arrays = aPE%Nr_arrays+1
151          aPE%array_list(aPE%Nr_arrays)%name        = aName
152          aPE%array_list(aPE%Nr_arrays)%coupleIndex = couple_index
153       end do
154
155       return
156    end SUBROUTINE PMC_G_SetName
157
158
159    SUBROUTINE sort_2d_i (array,sort_ind)
160       IMPLICIT none
161       INTEGER,DIMENSION(:,:),INTENT(INOUT)         :: array
162       INTEGER,INTENT(IN)                           :: sort_ind
163
164       !-- local Variables
165       INTEGER      :: i,j,n
166       INTEGER,DIMENSION(size(array,1))             :: tmp
167
168       n = size(array,2)
169       do j=1,n-1
170          do i=j+1,n
171             if(array(sort_ind,i) < array(sort_ind,j) )  then
172                tmp = array(:,i)
173                array(:,i) = array(:,j)
174                array(:,j) = tmp
175             end if
176          end do
177       end do
178
179       return
180    END  SUBROUTINE sort_2d_i
181
182#endif
183end MODULE pmc_general
Note: See TracBrowser for help on using the repository browser.