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

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 <http://www.gnu.org/licenses/>.
!
! Copyright 1997-2015 Leibniz Universitaet Hannover
!--------------------------------------------------------------------------------!
!
! Current revisions:
! ------------------
!
!
! Former revisions:
! -----------------
! $Id: pmc_general.f90 1787 2016-03-08 06:57:00Z gronemeier $
!
! 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