Changeset 4649 for palm/trunk/SOURCE/pmc_general_mod.f90
- Timestamp:
- Aug 25, 2020 12:11:17 PM (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/pmc_general_mod.f90
r4629 r4649 1 1 MODULE pmc_general 2 2 3 !------------------------------------------------------------------------------ !3 !--------------------------------------------------------------------------------------------------! 4 4 ! This file is part of the PALM model system. 5 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/>. 6 ! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General 7 ! Public License as published by the Free Software Foundation, either version 3 of the License, or 8 ! (at your option) any later version. 9 ! 10 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the 11 ! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General 12 ! Public License for more details. 13 ! 14 ! You should have received a copy of the GNU General Public License along with PALM. If not, see 15 ! <http://www.gnu.org/licenses/>. 17 16 ! 18 17 ! Copyright 1997-2020 Leibniz Universitaet Hannover 19 !------------------------------------------------------------------------------! 18 !--------------------------------------------------------------------------------------------------! 19 ! 20 20 ! 21 21 ! Current revisions: 22 ! ----------------- -22 ! ----------------- 23 23 ! 24 24 ! … … 26 26 ! ----------------- 27 27 ! $Id$ 28 ! support for MPI Fortran77 interface (mpif.h) removed 29 ! 28 ! File re-formatted to follow the PALM coding standard 29 ! 30 ! 4629 2020-07-29 09:37:56Z raasch 31 ! Support for MPI Fortran77 interface (mpif.h) removed 32 ! 30 33 ! 4360 2020-01-07 11:25:50Z suehring 31 34 ! Corrected "Former revisions" section … … 38 41 ! 3655 2019-01-07 16:51:22Z knoop 39 42 ! Determine number of coupled arrays dynamically. 40 ! 43 ! 41 44 ! 1762 2016-02-25 12:31:13Z hellstea 42 45 ! Initial revision by K. Ketelsen … … 46 49 ! 47 50 ! Structure definition and utilities of Palm Model Coupler 48 !------------------------------------------------------------------------------ !51 !--------------------------------------------------------------------------------------------------! 49 52 50 53 #if defined( __parallel ) … … 61 64 SAVE 62 65 63 INTEGER(iwp), PUBLIC :: pmc_max_array !< max # of arrays which can be coupled - will be determined dynamically in pmc_interface64 65 66 INTEGER(iwp), PARAMETER, PUBLIC :: da_desclen = 8 !< 66 67 INTEGER(iwp), PARAMETER, PUBLIC :: da_namelen = 16 !< … … 70 71 INTEGER(iwp), PARAMETER, PUBLIC :: pmc_status_error = -1 !< 71 72 73 INTEGER(iwp), PUBLIC :: pmc_max_array !< max # of arrays which can be coupled 74 !< - will be determined dynamically in pmc_interface 75 72 76 73 77 TYPE, PUBLIC :: xy_ind !< pair of indices in horizontal plane … … 77 81 78 82 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 83 CHARACTER(LEN=da_namelen) :: Name !< name of array 84 85 INTEGER(iwp) :: coupleindex !< 86 INTEGER(iwp) :: dimkey !< key for NR dimensions and array type 87 INTEGER(iwp) :: nrdims !< number of dimensions 88 INTEGER(iwp) :: RecvSize !< size in receive buffer 89 INTEGER(iwp) :: SendSize !< size in send buffer 90 91 INTEGER(idp) :: RecvIndex !< index in receive buffer 92 INTEGER(idp) :: SendIndex !< index in send buffer 93 94 INTEGER(iwp), DIMENSION(4) :: a_dim !< size of dimensions 95 96 TYPE(C_PTR) :: data !< pointer of data in parent space 97 TYPE(C_PTR) :: SendBuf !< data pointer in send buffer 98 TYPE(C_PTR) :: RecvBuf !< data pointer in receive buffer 99 100 TYPE(arraydef), POINTER :: next !< 101 102 TYPE(C_PTR), DIMENSION(2) :: po_data !< base pointers, pmc_s_set_active_data_array 103 !< sets active pointer 95 104 END TYPE arraydef 96 105 97 TYPE(arraydef), PUBLIC, POINTER :: next 106 107 TYPE(arraydef), PUBLIC, POINTER :: next !< 108 98 109 99 110 TYPE, PUBLIC :: pedef 100 111 INTEGER(iwp) :: nr_arrays = 0 !< number of arrays which will be transfered 101 112 INTEGER(iwp) :: nrele !< number of elements, same for all arrays 113 114 TYPE(arraydef), POINTER, DIMENSION(:) :: array_list !< list of data arrays to be transfered 102 115 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 transfered104 116 END TYPE pedef 105 117 118 106 119 TYPE, PUBLIC :: childdef 120 INTEGER(iwp) :: inter_comm !< inter communicator model and child 121 INTEGER(iwp) :: inter_npes !< number of PEs child model 122 INTEGER(iwp) :: intra_comm !< intra communicator model and child 123 INTEGER(iwp) :: intra_rank !< rank within intra_comm 124 INTEGER(iwp) :: model_comm !< communicator of this model 125 INTEGER(iwp) :: model_npes !< number of PEs this model 126 INTEGER(iwp) :: model_rank !< rank of this model 107 127 INTEGER(idp) :: totalbuffersize !< 108 INTEGER(iwp) :: model_comm !< communicator of this model109 INTEGER(iwp) :: inter_comm !< inter communicator model and child110 INTEGER(iwp) :: intra_comm !< intra communicator model and child111 INTEGER(iwp) :: model_rank !< rank of this model112 INTEGER(iwp) :: model_npes !< number of PEs this model113 INTEGER(iwp) :: inter_npes !< number of PEs child model114 INTEGER(iwp) :: intra_rank !< rank within intra_comm115 128 INTEGER(iwp) :: win_parent_child !< MPI RMA for preparing data on parent AND child side 116 129 TYPE(pedef), DIMENSION(:), POINTER :: pes !< list of all child PEs 117 130 END TYPE childdef 118 131 132 119 133 TYPE, PUBLIC :: da_namedef !< data array name definition 120 INTEGER(iwp) :: couple_index !< unique number of array121 CHARACTER(LEN=da_desclen) :: parentdesc !< parent array description122 CHARACTER(LEN=da_namelen) :: nameonparent !< name of array within parent123 134 CHARACTER(LEN=da_desclen) :: childdesc !< child array description 124 135 CHARACTER(LEN=da_namelen) :: nameonchild !< name of array within child 136 CHARACTER(LEN=da_namelen) :: nameonparent !< name of array within parent 137 CHARACTER(LEN=da_desclen) :: parentdesc !< parent array description 138 INTEGER(iwp) :: couple_index !< unique number of array 125 139 END TYPE da_namedef 126 140 … … 137 151 CONTAINS 138 152 139 140 153 !--------------------------------------------------------------------------------------------------! 154 ! Description: 155 ! ------------ 156 !> @Todo: Missing subroutine description. 157 !--------------------------------------------------------------------------------------------------! 141 158 SUBROUTINE pmc_g_setname( mychild, couple_index, aname ) 142 159 … … 144 161 145 162 CHARACTER(LEN=*) :: aname !< 163 146 164 INTEGER(iwp), INTENT(IN) :: couple_index !< 165 166 INTEGER(iwp) :: i !< 167 147 168 TYPE(childdef), INTENT(INOUT) :: mychild !< 148 149 INTEGER(iwp) :: i !<150 169 151 170 TYPE(pedef), POINTER :: ape !< … … 164 183 165 184 166 185 !--------------------------------------------------------------------------------------------------! 186 ! Description: 187 ! ------------ 188 !> @Todo: Missing subroutine description. 189 !--------------------------------------------------------------------------------------------------! 167 190 SUBROUTINE sort_2d_i( array, sort_ind ) 168 191 … … 178 201 INTEGER(iwp), DIMENSION(SIZE(array,1)) :: tmp !< 179 202 180 n = SIZE( array,2)203 n = SIZE( array, 2 ) 181 204 DO j = 1, n-1 182 205 DO i = j+1, n
Note: See TracChangeset
for help on using the changeset viewer.