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

Last change on this file since 4515 was 4360, checked in by suehring, 5 years ago

Bugfix in output of time-averaged plant-canopy quanities; Output of plant-canopy data only where tall canopy is defined; land-surface model: fix wrong location strings; tests: update urban test case; all source code files: copyright update

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