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 1767 2016-02-29 08:47:57Z raasch $ ! ! 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_MODELL = 64 ! TO_DO: the next variable doesn't seem to be used. Remove? INTEGER,parameter,PUBLIC :: PMC_MPI_REAL = MPI_DOUBLE_PRECISION 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 INTEGER :: dim_order ! Order of Dimensions: 2 = 2D array, 33 = 3D array 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) :: BufIndex ! index in Send Buffer INTEGER :: BufSize ! size in Send Buffer TYPE (c_ptr) :: SendBuf ! Pointer of Data in Send buffer CHARACTER(len=8) :: Name ! Name of Array Type(ArrayDef),POINTER :: next END TYPE ArrayDef TYPE (ArrayDef), PUBLIC, POINTER :: next; TYPE, PUBLIC :: PeDef INTEGER(idp) :: NrEle ! Number of Elemets TYPE (xy_ind), POINTER,DIMENSION(:) :: locInd ! xy index local array for remote PE TYPE( ArrayDef), POINTER :: Arrays ! Pointer to Data Array List (Type ArrayDef) TYPE( ArrayDef), POINTER :: ArrayStart ! Pointer to Star of the List 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 :: BufWin ! MPI RMA windows 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_G_GetName MODULE procedure PMC_G_GetName end INTERFACE PMC_G_GetName INTERFACE PMC_sort MODULE procedure sort_2d_i end INTERFACE PMC_sort PUBLIC PMC_G_SetName, PMC_G_GetName, 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 do i=1,myClient%inter_npes aPE => myClient%PEs(i) ar => aPE%Arrays if(.not. associated (ar) ) then ar => DA_List_append (ar, couple_index) aPE%ArrayStart => ar else ar => DA_List_append (ar, couple_index) endif Ar%Name = trim(aName) // " " myClient%PEs(i)%Arrays => ar end do return end SUBROUTINE PMC_G_SetName SUBROUTINE PMC_G_GetName (myClient, couple_index, aName, aLast,Client_PeIndex) IMPLICIT none TYPE(ClientDef),INTENT(INOUT) :: myClient INTEGER,INTENT(OUT) :: couple_index CHARACTER(LEN=*),INTENT(OUT) :: aName logical,INTENT(OUT) :: aLast INTEGER,INTENT(IN),optional :: Client_PeIndex INTEGER :: i,istart,istop TYPE(PeDef),POINTER :: aPE TYPE(ArrayDef),POINTER :: ar logical,save :: first=.true. aLast = .false. if(present(Client_PeIndex)) then !Loop over all Client PEs or just one selected via Client_PeIndex istart = Client_PeIndex istop = Client_PeIndex else istart = 1 istop = myClient%inter_npes end if do i=istart,istop aPE => myClient%PEs(i) ar => aPE%Arrays if(first) then ar => aPE%ArrayStart else ar => aPE%Arrays ar => DA_List_next (ar) if(.not. associated (ar) ) then aLast = .true. first = .true. !Reset linked list to begin aPE%Arrays => ar end if endif aPE%Arrays => ar end do if(aLast) then return end if couple_index = ar%coupleIndex aName = ar%Name aLast = .false. first = .false. return END SUBROUTINE PMC_G_GetName 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 ! Private section ! linked List routines for Data Array handling FUNCTION DA_List_append (node, couple_index) TYPE(ArrayDef),POINTER :: DA_List_append TYPE(ArrayDef),POINTER :: node INTEGER,INTENT(IN) :: couple_index !-- local variables TYPE(ArrayDef),POINTER :: ar if(.not. associated (node)) then ALLOCATE(ar) ar%coupleIndex = couple_index NULLIFY(ar%next) DA_List_append => ar else ALLOCATE(node%next) node%next%coupleIndex = couple_index NULLIFY(node%next%next) DA_List_append => node%next end if return END FUNCTION DA_List_append FUNCTION DA_List_next (node) TYPE(ArrayDef),POINTER :: DA_List_next TYPE(ArrayDef),POINTER :: node DA_List_next => node%next return END FUNCTION DA_List_next #endif end MODULE pmc_general