Ignore:
Timestamp:
May 4, 2016 3:27:53 PM (5 years ago)
Author:
raasch
Message:

re-formatting of remaining pmc routines

File:
1 moved

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/pmc_general_mod.f90

    r1899 r1900  
    1 MODULE pmc_general
     1 MODULE pmc_general
    22
    33!--------------------------------------------------------------------------------!
     
    2020! Current revisions:
    2121! ------------------
    22 !
     22! re-formatted to match PALM style, file renamed again
    2323!
    2424! Former revisions:
     
    5454
    5555#if defined( __parallel )
    56    use, intrinsic :: iso_c_binding
    57 
    58    USE kinds
     56    USE, INTRINSIC ::  ISO_C_BINDING
     57
     58    USE kinds
    5959
    6060#if defined( __mpifh )
     
    6464#endif
    6565
    66    IMPLICIT none
    67    PRIVATE
    68    SAVE
    69 
    70 ! return status
    71    INTEGER,parameter,PUBLIC              :: PMC_STATUS_OK    = 0
    72    INTEGER,parameter,PUBLIC              :: PMC_STATUS_ERROR = -1
    73    INTEGER,parameter,PUBLIC              :: PMC_DA_NAME_ERR  = 10
    74 
    75    INTEGER,parameter,PUBLIC              :: PMC_MAX_ARRAY    = 32  !Max Number of Array which can be coupled
    76    INTEGER,parameter,PUBLIC              :: PMC_MAX_MODELL   = 64
    77    INTEGER,parameter,PUBLIC              :: DA_Desclen       = 8
    78    INTEGER,parameter,PUBLIC              :: DA_Namelen       = 16
    79 
    80    TYPE, PUBLIC :: xy_ind                                          ! Pair of indices in horizontal plane
    81       INTEGER                      ::  i
    82       INTEGER                      ::  j
    83    END TYPE
    84 
    85    TYPE, PUBLIC :: ArrayDef
    86       INTEGER                       :: coupleIndex
    87       INTEGER                       :: NrDims                      ! Number of Dimensions
    88       INTEGER,DIMENSION(4)          :: A_dim                       ! Size of dimensions
    89       TYPE(c_ptr)                   :: data                        ! Pointer of data in server space
    90       TYPE(c_ptr), DIMENSION(2)     :: po_data                     ! Base Pointers, PMC_S_Set_Active_data_array sets active pointer
    91       INTEGER(idp)                  :: SendIndex                   ! index in Send Buffer
    92       INTEGER(idp)                  :: RecvIndex                   ! index in Receive Buffer
    93       INTEGER                       :: SendSize                    ! size in Send Buffer
    94       INTEGER                       :: RecvSize                    ! size in Receiver Buffer
    95       TYPE (c_ptr)                  :: SendBuf                     ! Pointer of Data in Send buffer
    96       TYPE (c_ptr)                  :: RecvBuf                     ! Pointer of Data in ReceiveS buffer
    97       CHARACTER(len=8)              :: Name                        ! Name of Array
    98 
    99       Type(ArrayDef),POINTER        :: next
    100    END TYPE ArrayDef
    101 
    102    TYPE (ArrayDef), PUBLIC, POINTER :: next;
    103 
    104    TYPE, PUBLIC :: PeDef
    105       INTEGER                                :: Nr_arrays=0        ! Number of arrays which will be transfered in this run
    106       INTEGER                                :: NrEle              ! Number of Elemets, same for all arrays
    107       TYPE (xy_ind), POINTER,DIMENSION(:)    :: locInd             ! xy index local array for remote PE
    108       TYPE( ArrayDef), POINTER, DIMENSION(:) :: array_list         ! List of Data Arrays to be transfered
    109    END TYPE PeDef
    110 
    111    TYPE, PUBLIC :: ClientDef
    112       INTEGER(idp)                  :: TotalBufferSize
    113       INTEGER                       :: model_comm                  ! Communicator of this model
    114       INTEGER                       :: inter_comm                  ! Inter communicator model and client
    115       INTEGER                       :: intra_comm                  ! Intra communicator model and client
    116       INTEGER                       :: model_rank                  ! Rank of this model
    117       INTEGER                       :: model_npes                  ! Number of PEs this model
    118       INTEGER                       :: inter_npes                  ! Number of PEs client model
    119       INTEGER                       :: intra_rank                  ! rank within intra_comm
    120       INTEGER                       :: win_server_client           ! MPI RMA for preparing data on server AND client side
    121       TYPE (PeDef), DIMENSION(:), POINTER      :: PEs              ! List of all Client PEs
    122    END TYPE ClientDef
    123 
    124    TYPE, PUBLIC    :: DA_NameDef                                   ! Data Array Name Definition
    125       INTEGER                       :: couple_index                ! Unique Number of Array
    126       CHARACTER(len=DA_Desclen)     :: ServerDesc                  ! Server array description
    127       CHARACTER(len=DA_Namelen)     :: NameOnServer                ! Name of array within Server
    128       CHARACTER(len=DA_Desclen)     :: ClientDesc                  ! Client array description
    129       CHARACTER(len=DA_Namelen)     :: NameOnClient                ! Name of array within Client
    130     END TYPE DA_NameDef
    131 
    132     INTERFACE PMC_G_SetName
    133        MODULE procedure PMC_G_SetName
    134     end INTERFACE PMC_G_SetName
    135 
    136     INTERFACE PMC_sort
    137        MODULE procedure sort_2d_i
    138     end INTERFACE PMC_sort
    139 
    140     PUBLIC PMC_G_SetName, PMC_sort
    141 
     66    IMPLICIT NONE
     67
     68    PRIVATE
     69    SAVE
     70
     71    INTEGER, PARAMETER, PUBLIC :: da_desclen       =  8  !<
     72    INTEGER, PARAMETER, PUBLIC :: da_namelen       = 16  !<
     73    INTEGER, PARAMETER, PUBLIC :: pmc_da_name_err  = 10  !<
     74    INTEGER, PARAMETER, PUBLIC :: pmc_max_array    = 32  !< max # of arrays which can be coupled
     75    INTEGER, PARAMETER, PUBLIC :: pmc_max_models   = 64  !<
     76    INTEGER, PARAMETER, PUBLIC :: pmc_status_ok    =  0  !<
     77    INTEGER, PARAMETER, PUBLIC :: pmc_status_error = -1  !<
     78
     79
     80    TYPE, PUBLIC :: xy_ind  !< pair of indices in horizontal plane
     81       INTEGER ::  i
     82       INTEGER ::  j
     83    END TYPE
     84
     85    TYPE, PUBLIC ::  arraydef
     86       INTEGER                   :: coupleindex  !<
     87       INTEGER                   :: nrdims       !< number of dimensions
     88       INTEGER, DIMENSION(4)     :: a_dim        !< size of dimensions
     89       TYPE(C_PTR)               :: data         !< pointer of data in server space
     90       TYPE(C_PTR), DIMENSION(2) :: po_data      !< base pointers,
     91                                                 !< pmc_s_set_active_data_array
     92                                                 !< sets active pointer
     93       INTEGER(idp)              :: SendIndex    !< index in send buffer
     94       INTEGER(idp)              :: RecvIndex    !< index in receive buffer
     95       INTEGER                   :: SendSize     !< size in send buffer
     96       INTEGER                   :: RecvSize     !< size in receive buffer
     97       TYPE(C_PTR)               :: SendBuf      !< data pointer in send buffer
     98       TYPE(C_PTR)               :: RecvBuf      !< data pointer in receive buffer
     99       CHARACTER(LEN=8)          :: Name         !< name of array
     100       TYPE(arraydef), POINTER   :: next
     101    END TYPE arraydef
     102
     103    TYPE(arraydef), PUBLIC, POINTER  :: next
     104
     105    TYPE, PUBLIC ::  pedef
     106       INTEGER :: nr_arrays = 0  !< number of arrays which will be transfered
     107       INTEGER :: nrele          !< number of elements, same for all arrays
     108       TYPE(xy_ind), POINTER, DIMENSION(:)   ::  locInd      !< xy index local array for remote PE
     109       TYPE(arraydef), POINTER, DIMENSION(:) ::  array_list  !< list of data arrays to be transfered
     110    END TYPE pedef
     111
     112    TYPE, PUBLIC ::  clientdef
     113       INTEGER(idp) ::  totalbuffersize    !<
     114       INTEGER      ::  model_comm         !< communicator of this model
     115       INTEGER      ::  inter_comm         !< inter communicator model and client
     116       INTEGER      ::  intra_comm         !< intra communicator model and client
     117       INTEGER      ::  model_rank         !< rank of this model
     118       INTEGER      ::  model_npes         !< number of PEs this model
     119       INTEGER      ::  inter_npes         !< number of PEs client model
     120       INTEGER      ::  intra_rank         !< rank within intra_comm
     121       INTEGER      ::  win_server_client  !< MPI RMA for preparing data on server AND client side
     122       TYPE(pedef), DIMENSION(:), POINTER ::  pes  !< list of all client PEs
     123    END TYPE clientdef
     124
     125    TYPE, PUBLIC ::  da_namedef  !< data array name definition
     126       INTEGER                   ::  couple_index  !< unique number of array
     127       CHARACTER(LEN=da_desclen) ::  serverdesc    !< server array description
     128       CHARACTER(LEN=da_namelen) ::  nameonserver  !< name of array within server
     129       CHARACTER(LEN=da_desclen) ::  clientdesc    !< client array description
     130       CHARACTER(LEN=da_namelen) ::  nameonclient  !< name of array within client
     131    END TYPE da_namedef
     132
     133    INTERFACE pmc_g_setname
     134       MODULE PROCEDURE pmc_g_setname
     135    END INTERFACE pmc_g_setname
     136
     137    INTERFACE pmc_sort
     138       MODULE PROCEDURE sort_2d_i
     139    END INTERFACE pmc_sort
     140
     141    PUBLIC pmc_g_setname, pmc_sort
    142142
    143143 CONTAINS
    144     SUBROUTINE PMC_G_SetName (myClient, couple_index, aName)
    145        IMPLICIT none
    146 
    147        TYPE(ClientDef),INTENT(INOUT)           :: myClient
    148        INTEGER,INTENT(IN)                      :: couple_index
    149        CHARACTER(LEN=*)                        :: aName
    150 
    151        INTEGER                                 :: i
    152        TYPE(ArrayDef),POINTER                  :: ar
    153        TYPE(PeDef),POINTER                     :: aPE
    154 
    155 !
    156 !--    Assign array to next free index in array_list.
    157 !--    Set name of array in ArrayDef structure
    158        do i=1,myClient%inter_npes
    159           aPE => myClient%PEs(i)
    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        end do
    164 
    165        return
    166     end SUBROUTINE PMC_G_SetName
    167 
    168 
    169     SUBROUTINE sort_2d_i (array,sort_ind)
    170        IMPLICIT none
    171        INTEGER,DIMENSION(:,:),INTENT(INOUT)         :: array
    172        INTEGER,INTENT(IN)                           :: sort_ind
    173 
    174        !-- local Variables
    175        INTEGER      :: i,j,n
    176        INTEGER,DIMENSION(size(array,1))             :: tmp
    177 
    178        n = size(array,2)
    179        do j=1,n-1
    180           do i=j+1,n
    181              if(array(sort_ind,i) < array(sort_ind,j) )  then
    182                 tmp = array(:,i)
    183                 array(:,i) = array(:,j)
    184                 array(:,j) = tmp
    185              end if
    186           end do
    187        end do
    188 
    189        return
    190     END  SUBROUTINE sort_2d_i
     144
     145 SUBROUTINE pmc_g_setname( myclient, couple_index, aname )
     146
     147    IMPLICIT NONE
     148
     149    CHARACTER(LEN=*)               ::  aname         !<
     150    INTEGER, INTENT(IN)            ::  couple_index  !<
     151    TYPE(clientdef), INTENT(INOUT) ::  myclient      !<
     152
     153    INTEGER ::  i  !<
     154
     155    TYPE(arraydef), POINTER ::  ar   !<
     156    TYPE(pedef), POINTER    ::  ape  !<
     157
     158!
     159!-- Assign array to next free index in array list.
     160!-- Set name of array in arraydef structure
     161    DO  i = 1, myclient%inter_npes
     162
     163       ape => myclient%pes(i)
     164       ape%nr_arrays = ape%nr_arrays + 1
     165       ape%array_list(ape%nr_arrays)%name        = aname
     166       ape%array_list(ape%nr_arrays)%coupleindex = couple_index
     167
     168    ENDDO
     169
     170 END SUBROUTINE pmc_g_setname
     171
     172
     173
     174 SUBROUTINE sort_2d_i( array, sort_ind )
     175
     176    IMPLICIT NONE
     177
     178    INTEGER, INTENT(IN)                    ::  sort_ind
     179    INTEGER, DIMENSION(:,:), INTENT(INOUT) ::  array
     180
     181    INTEGER ::  i  !<
     182    INTEGER ::  j  !<
     183    INTEGER ::  n  !<
     184
     185    INTEGER, DIMENSION(SIZE(array,1)) ::  tmp  !<
     186
     187    n = SIZE(array,2)
     188
     189    DO  j = 1, n-1
     190       DO  i = j+1, n
     191
     192          IF ( array(sort_ind,i) < array(sort_ind,j) )  THEN
     193             tmp = array(:,i)
     194             array(:,i) = array(:,j)
     195             array(:,j) = tmp
     196          ENDIF
     197
     198       ENDDO
     199    ENDDO
     200
     201 END  SUBROUTINE sort_2d_i
    191202
    192203#endif
    193 end MODULE pmc_general
     204 END MODULE pmc_general
Note: See TracChangeset for help on using the changeset viewer.