MODULE pmc_general !--------------------------------------------------------------------------------! ! This file is part of PALM. ! ! PALM is free software: you can redistribute it and/or modify it under the terms ! of the GNU General Public License as published by the Free Software Foundation, ! either version 3 of the License, or (at your option) any later version. ! ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR ! A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License along with ! PALM. If not, see . ! ! Copyright 1997-2015 Leibniz Universitaet Hannover !--------------------------------------------------------------------------------! ! ! Current revisions: ! ------------------ ! ! ! Former revisions: ! ----------------- ! $Id: pmc_general.f90 1787 2016-03-08 06:57:00Z raasch $ ! ! 1786 2016-03-08 05:49:27Z raasch ! change in client-server data transfer: server now gets data from client ! instead that client put's it to the server ! ! 1779 2016-03-03 08:01:28Z raasch ! PMC_MPI_REAL removed, dim_order removed from type arraydef, ! array management changed from linked list to sequential loop ! ! 1766 2016-02-29 08:37:15Z raasch ! +po_data in type arraydef ! ! 1764 2016-02-28 12:45:19Z raasch ! cpp-statement added (nesting can only be used in parallel mode), ! all kinds given in PALM style ! ! 1762 2016-02-25 12:31:13Z hellstea ! Initial revision by K. Ketelsen ! ! Description: ! ------------ ! ! Structure definition and utilities of Palm Model Coupler !------------------------------------------------------------------------------! #if defined( __parallel ) use, intrinsic :: iso_c_binding USE kinds #if defined( __lc ) USE MPI #else INCLUDE "mpif.h" #endif IMPLICIT none PRIVATE SAVE ! return status INTEGER,parameter,PUBLIC :: PMC_STATUS_OK = 0 INTEGER,parameter,PUBLIC :: PMC_STATUS_ERROR = -1 INTEGER,parameter,PUBLIC :: PMC_DA_NAME_ERR = 10 INTEGER,parameter,PUBLIC :: PMC_MAX_ARRAY = 32 !Max Number of Array which can be coupled INTEGER,parameter,PUBLIC :: PMC_MAX_MODELL = 64 INTEGER,parameter,PUBLIC :: DA_Desclen = 8 INTEGER,parameter,PUBLIC :: DA_Namelen = 16 TYPE, PUBLIC :: xy_ind ! Pair of indices in horizontal plane INTEGER :: i INTEGER :: j END TYPE TYPE, PUBLIC :: ArrayDef INTEGER :: coupleIndex INTEGER :: NrDims ! Number of Dimensions INTEGER,DIMENSION(4) :: A_dim ! Size of dimensions TYPE(c_ptr) :: data ! Pointer of data in server space TYPE(c_ptr), DIMENSION(2) :: po_data ! Base Pointers, PMC_S_Set_Active_data_array sets active pointer INTEGER(idp) :: SendIndex ! index in Send Buffer INTEGER(idp) :: RecvIndex ! index in Receive Buffer INTEGER :: SendSize ! size in Send Buffer INTEGER :: RecvSize ! size in Receiver Buffer TYPE (c_ptr) :: SendBuf ! Pointer of Data in Send buffer TYPE (c_ptr) :: RecvBuf ! Pointer of Data in ReceiveS buffer CHARACTER(len=8) :: Name ! Name of Array Type(ArrayDef),POINTER :: next END TYPE ArrayDef TYPE (ArrayDef), PUBLIC, POINTER :: next; TYPE, PUBLIC :: PeDef INTEGER :: Nr_arrays=0 ! Number of arrays which will be transfered in this run INTEGER :: NrEle ! Number of Elemets, same for all arrays TYPE (xy_ind), POINTER,DIMENSION(:) :: locInd ! xy index local array for remote PE TYPE( ArrayDef), POINTER, DIMENSION(:) :: array_list ! List of Data Arrays to be transfered END TYPE PeDef TYPE, PUBLIC :: ClientDef INTEGER(idp) :: TotalBufferSize INTEGER :: model_comm ! Communicator of this model INTEGER :: inter_comm ! Inter communicator model and client INTEGER :: intra_comm ! Intra communicator model and client INTEGER :: model_rank ! Rank of this model INTEGER :: model_npes ! Number of PEs this model INTEGER :: inter_npes ! Number of PEs client model INTEGER :: intra_rank ! rank within intra_comm INTEGER :: win_server_client ! MPI RMA for preparing data on server AND client side TYPE (PeDef), DIMENSION(:), POINTER :: PEs ! List of all Client PEs END TYPE ClientDef TYPE, PUBLIC :: DA_NameDef ! Data Array Name Definition INTEGER :: couple_index ! Unique Number of Array CHARACTER(len=DA_Desclen) :: ServerDesc ! Server array description CHARACTER(len=DA_Namelen) :: NameOnServer ! Name of array within Server CHARACTER(len=DA_Desclen) :: ClientDesc ! Client array description CHARACTER(len=DA_Namelen) :: NameOnClient ! Name of array within Client END TYPE DA_NameDef INTERFACE PMC_G_SetName MODULE procedure PMC_G_SetName end INTERFACE PMC_G_SetName INTERFACE PMC_sort MODULE procedure sort_2d_i end INTERFACE PMC_sort PUBLIC PMC_G_SetName, PMC_sort CONTAINS SUBROUTINE PMC_G_SetName (myClient, couple_index, aName) IMPLICIT none TYPE(ClientDef),INTENT(INOUT) :: myClient INTEGER,INTENT(IN) :: couple_index CHARACTER(LEN=*) :: aName INTEGER :: i TYPE(ArrayDef),POINTER :: ar TYPE(PeDef),POINTER :: aPE ! !-- Assign array to next free index in array_list. !-- Set name of array in ArrayDef structure do i=1,myClient%inter_npes aPE => myClient%PEs(i) aPE%Nr_arrays = aPE%Nr_arrays+1 aPE%array_list(aPE%Nr_arrays)%name = aName aPE%array_list(aPE%Nr_arrays)%coupleIndex = couple_index end do return end SUBROUTINE PMC_G_SetName SUBROUTINE sort_2d_i (array,sort_ind) IMPLICIT none INTEGER,DIMENSION(:,:),INTENT(INOUT) :: array INTEGER,INTENT(IN) :: sort_ind !-- local Variables INTEGER :: i,j,n INTEGER,DIMENSION(size(array,1)) :: tmp n = size(array,2) do j=1,n-1 do i=j+1,n if(array(sort_ind,i) < array(sort_ind,j) ) then tmp = array(:,i) array(:,i) = array(:,j) array(:,j) = tmp end if end do end do return END SUBROUTINE sort_2d_i #endif end MODULE pmc_general