- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Hi,
I am trying to compile my code on a linux platform, migrating from an IRIX box that served me faithfully for the last 7-8 years.
When compling the code below, (I show only the relevant part), using the following compiler options:
mpif90 -std -fpconstant -g -traceback -debug -O0 -fpe0 -check_bounds gs_module.f90
I get these warnings and then errors:
gs_module.f90(14): warning #6738: The type/rank/keyword signature for this specific procedure matches another specific procedure that shares the same generic-name. [SCATTER_MODULE^MAX_SCATTER_VECTOR_DOUBLE]
use scatter_module, only: SUM_SCATTER, MIN_SCATTER, MAX_SCATTER, OR_SCATTER
------^
gs_module.f90(258): error #8032: Generic procedure reference has two or more specific procedure with the same type/rank/keyword signature. [GATHER]
call gather (Dest, Src, Mesh, TYPE = EE, TRACE = EE_TRACE, &
---------^
gs_module.f90(293): error #8032: Generic procedure reference has two or more specific procedure with the same type/rank/keyword signature. [GATHER]
call gather (Dest, Src, Mesh, TYPE = EE, TRACE = EE_TRACE, &
---------^
I would welcome any solution to this compiling error (I care less about the warnings).
Thanks,
Adrian
MODULE GS_MODULE
!=======================================================================
! Purpose(s):
!
! Define the interfaces and global variables
! for the gather/scatter support
!
!=======================================================================
use gather_module, only: GATHER
use gs_info_module, only: EN_TRACE, EE_TRACE, EN, EE
use kind_module, only: log_kind
use parameter_module
use scatter_module, only: SUM_SCATTER, MIN_SCATTER, MAX_SCATTER, OR_SCATTER
implicit none
! Private Module
private
! Public procedures
Public :: EE_Gather, EN_Gather, EN_MIN_Gather, EN_MAX_Gather, EN_OR_Gather, &
EN_SUM_Scatter, EN_MIN_Scatter, EN_MAX_Scatter, EN_OR_Scatter, &
EE_GS_INIT, EN_GS_INIT
! Arrays and variables used only inside this module
logical(KIND = log_kind), save, private, pointer, dimension(:,:) :: El_Nbr_MASK
logical(KIND = log_kind), save, private :: EE_MASK_Initialized = .false.
! <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
! Interface blocks
INTERFACE EE_GATHER
!=======================================================================
! Purpose -
! Gather integer cell-centered data from cell face neighbors
! into a integer cell-centered vector of length nfc
!
! Input:
! Mesh - Mesh connectivity structure
! Src - Cell-centered quantity
! Output:
! Dest - Cell-centered vector of length nfc containing
! the value of Src for all face neighbor cells
!
!=======================================================================
MODULE PROCEDURE EE_GATHER_INT
MODULE PROCEDURE EE_GATHER_SINGLE
MODULE PROCEDURE EE_GATHER_DOUBLE
END INTERFACE
!========== EE_GATHER_INT========================================
! This is included by gs_module for the top level gather routines.
! This is the parallel version
SUBROUTINE EE_GATHER_INT (Dest, Src, BOUNDARY)
!=======================================================================
! PURPOSE -
!
!=======================================================================
use gs_info_module, only: EE_TRACE, EE
use kind_module
use mesh_module, only: Mesh
use pgslib_module, only: PGSLib_GS_Trace_Setup_P
implicit none
! Incoming Arguments
integer (int_kind) , intent(IN ), &
dimension (ncells) :: Src
integer (int_kind) , intent( OUT), &
dimension (nfc,ncells) :: Dest
integer (int_kind) , dimension (:), &
POINTER, &
OPTIONAL :: BOUNDARY
! Local Variables
! <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
! Initialize relevant quantities
Dest = 0_int_kind
IF (.NOT. EE_MASK_Initialized) then
EE_MASK_Initialized = .true.
call gs_init_ee_mask()
END IF
IF (.NOT. PGSLib_GS_Trace_Setup_P(EE_Trace)) Call EE_GS_Init()
call gather (Dest, Src, Mesh, TYPE = EE, TRACE = EE_TRACE, &
MASK = El_Nbr_Mask, BOUNDARY = BOUNDARY)
return
END SUBROUTINE EE_GATHER_INT
!========== EE_GATHER_SINGLE========================================
! This is included by gs_module for the top level gather routines.
! This is the parallel version
SUBROUTINE EE_GATHER_SINGLE (Dest, Src, BOUNDARY)
!=======================================================================
! PURPOSE -
!
!=======================================================================
use gs_info_module, only: EE_TRACE, EE
use kind_module
use mesh_module, only: Mesh
use pgslib_module, only: PGSLib_GS_Trace_Setup_P
implicit none
! Incoming Arguments
real (single_kind) , intent(IN ), &
dimension (ncells) :: Src
real (single_kind) , intent( OUT), &
dimension (nfc,ncells) :: Dest
real (single_kind) , dimension (:), &
POINTER, &
OPTIONAL :: BOUNDARY
! Local Variables
! <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
! Initialize relevant quantities
Dest = 0.0_single_kind
IF (.NOT. EE_MASK_Initialized) then
EE_MASK_Initialized = .true.
call gs_init_ee_mask()
END IF
IF (.NOT. PGSLib_GS_Trace_Setup_P(EE_Trace)) Call EE_GS_Init()
call gather (Dest, Src, Mesh, TYPE = EE, TRACE = EE_TRACE, &
MASK = El_Nbr_Mask, BOUNDARY = BOUNDARY)
return
END SUBROUTINE EE_GATHER_SINGLE
!========== EE_GATHER_DOUBLE========================================
! This is included by gs_module for the top level gather routines.
! This is the parallel version
SUBROUTINE EE_GATHER_DOUBLE (Dest, Src, BOUNDARY)
!=======================================================================
! PURPOSE -
!
!=======================================================================
use gs_info_module, only: EE_TRACE, EE
use kind_module
use mesh_module, only: Mesh
use pgslib_module, only: PGSLib_GS_Trace_Setup_P
implicit none
! Incoming Arguments
real (double_kind) , intent(IN ), &
dimension (ncells) :: Src
real (double_kind) , intent( OUT), &
dimension (nfc,ncells) :: Dest
real (double_kind) , dimension (:), &
POINTER, &
OPTIONAL :: BOUNDARY
! Local Variables
! <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
! Initialize relevant quantities
Dest = 0.0_double_kind
IF (.NOT. EE_MASK_Initialized) then
EE_MASK_Initialized = .true.
call gs_init_ee_mask()
END IF
IF (.NOT. PGSLib_GS_Trace_Setup_P(EE_Trace)) Call EE_GS_Init()
call gather (Dest, Src, Mesh, TYPE = EE, TRACE = EE_TRACE, &
MASK = El_Nbr_Mask, BOUNDARY = BOUNDARY)
return
END SUBROUTINE EE_GATHER_DOUBLE
END MODULE GS_MODULE
=================
the other module where gather is defined
MODULE GATHER_MODULE
!=======================================================================
! PURPOSE -
! Routines for gather. These are used by both
! Element<->Element and Element<->Node.
!
!=======================================================================
use gs_info_module
use pgslib_module, ONLY: PGSLib_GS_Struct, PGSLib_Gather_Buffer
implicit none
save
public :: Gather
! Interface blocks
INTERFACE Gather
!=======================================================================
! PURPOSE -
! Gather either cell-centered data or vertex centered data
! into a cell-centered vector of length ShortDim
!
! Input:
! Mesh - Mesh connectivity structure
! Src - Cell or vertex -centered quantity
! Output:
! Dest - Cell-centered vector of length ShortDim containing
! the value of Src for all neighbors
!
!=======================================================================
MODULE PROCEDURE Gather_INT
MODULE PROCEDURE Gather_SINGLE
MODULE PROCEDURE Gather_DOUBLE
END INTERFACE
! <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
CONTAINS
!=======================================================================
! PURPOSE -
! Gather either cell-centered data or vertex centered integer data
! into an integer cell-centered vector of length ShortDim
!=======================================================================
SUBROUTINE GATHER_INT (Dest, Src, Mesh, TYPE, TRACE, BOUNDARY, MASK)
!=======================================================================
! PURPOSE -
! Gather either cell-centered data or vertex centered integer data
! into a integer (int_kind) cell-centered vector of length ShortDim
!=======================================================================
use error_module, only: PUNT
use kind_module
use mesh_module, only: MESH_CONNECTIVITY, CllNgbr, Vrtx
implicit none
! Arguments
integer (int_kind) , dimension(:,:), &
intent(OUT) :: Dest
integer (int_kind) , dimension(:), &
intent(IN) :: Src
type(MESH_CONNECTIVITY), dimension(SIZE(Dest,2)), &
intent(IN) :: Mesh
integer (int_kind) , dimension(:), &
POINTER, &
OPTIONAL :: BOUNDARY
logical(KIND = log_kind), dimension(SIZE(Dest,1), SIZE(Dest,2)), &
intent(IN ), &
OPTIONAL :: MASK
type (COMM_TYPE), intent(IN ) :: TYPE
type (PGSLib_GS_Struct), intent(IN) :: Trace
! Local scalars & arrays
integer(KIND = int_kind) :: f, c
logical(KIND = log_kind) :: PRESENT_MASK, TEMP_BOUNDARY, NEW_BOUNDARY
integer (int_kind), POINTER, dimension(:) :: Supplement_Data
integer (int_kind), dimension(Trace%N_Duplicate) :: Duplicate_Data
! <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
! Initialize relevant quantities
PRESENT_MASK = PRESENT(MASK)
! If BOUNDARY is not passed in, then we have to use a local
! boundaray. If BOUNDARY is passed in, then if it is NULL
TEMP_BOUNDARY = .NOT. PRESENT(BOUNDARY)
! If the BOUNDARY is associated, use it, otherwise get new boundary data.
IF (TEMP_BOUNDARY) THEN
NEW_BOUNDARY = .TRUE.
ELSE
NEW_BOUNDARY = .NOT. ASSOCIATED(BOUNDARY)
ENDIF
IF (NEW_BOUNDARY) THEN
ALLOCATE(Supplement_Data(Trace%N_Supplement))
IF (.NOT. TEMP_BOUNDARY) BOUNDARY => Supplement_Data
! Gather into comm buffer
Duplicate_Data = Src(Trace%Duplicate_Indices)
ELSE
! If we were passed in a boundary, and it was allocated already,
! then us it
IF (.NOT. TEMP_BOUNDARY) Supplement_Data => BOUNDARY
END IF
IF (TEMP_BOUNDARY) DEALLOCATE(Supplement_Data)
return
END SUBROUTINE GATHER_INT
!=======================================================================
! PURPOSE -
! Gather either cell-centered data or vertex centered single data
! into a single cell-centered vector of length ShortDim
!=======================================================================
! This is included for the gather routines.
! This is the parallel version
SUBROUTINE GATHER_SINGLE (Dest, Src, Mesh, TYPE, TRACE, BOUNDARY, MASK)
!=======================================================================
! PURPOSE -
! Gather either cell-centered data or vertex centered integer data
! into a real (single_kind) cell-centered vector of length ShortDim
!=======================================================================
use error_module, only: PUNT
use kind_module
use mesh_module, only: MESH_CONNECTIVITY, CllNgbr, Vrtx
implicit none
! Arguments
real (single_kind) , dimension(:,:), &
intent(OUT) :: Dest
real (single_kind) , dimension(:), &
intent(IN) :: Src
type(MESH_CONNECTIVITY), dimension(SIZE(Dest,2)), &
intent(IN) :: Mesh
real (single_kind) , dimension(:), &
POINTER, &
OPTIONAL :: BOUNDARY
logical(KIND = log_kind), dimension(SIZE(Dest,1), SIZE(Dest,2)), &
intent(IN ), &
OPTIONAL :: MASK
type (COMM_TYPE), intent(IN ) :: TYPE
type (PGSLib_GS_Struct), intent(IN) :: Trace
! Local scalars & arrays
integer(KIND = int_kind) :: f, c
logical(KIND = log_kind) :: PRESENT_MASK, TEMP_BOUNDARY, NEW_BOUNDARY
real (single_kind), POINTER, dimension(:) :: Supplement_Data
real (single_kind), dimension(Trace%N_Duplicate) :: Duplicate_Data
! <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
! Initialize relevant quantities
PRESENT_MASK = PRESENT(MASK)
! If BOUNDARY is not passed in, then we have to use a local
! boundaray. If BOUNDARY is passed in, then if it is NULL
TEMP_BOUNDARY = .NOT. PRESENT(BOUNDARY)
! If the BOUNDARY is associated, use it, otherwise get new boundary data.
IF (TEMP_BOUNDARY) THEN
NEW_BOUNDARY = .TRUE.
ELSE
NEW_BOUNDARY = .NOT. ASSOCIATED(BOUNDARY)
ENDIF
IF (NEW_BOUNDARY) THEN
ALLOCATE(Supplement_Data(Trace%N_Supplement))
IF (.NOT. TEMP_BOUNDARY) BOUNDARY => Supplement_Data
! Gather into comm buffer
Duplicate_Data = Src(Trace%Duplicate_Indices)
ELSE
! If we were passed in a boundary, and it was allocated already,
! then us it
IF (.NOT. TEMP_BOUNDARY) Supplement_Data => BOUNDARY
END IF
IF (TEMP_BOUNDARY) DEALLOCATE(Supplement_Data)
return
END SUBROUTINE GATHER_SINGLE
END MODULE GATHER_MODULE
I am trying to compile my code on a linux platform, migrating from an IRIX box that served me faithfully for the last 7-8 years.
When compling the code below, (I show only the relevant part), using the following compiler options:
mpif90 -std -fpconstant -g -traceback -debug -O0 -fpe0 -check_bounds gs_module.f90
I get these warnings and then errors:
gs_module.f90(14): warning #6738: The type/rank/keyword signature for this specific procedure matches another specific procedure that shares the same generic-name. [SCATTER_MODULE^MAX_SCATTER_VECTOR_DOUBLE]
use scatter_module, only: SUM_SCATTER, MIN_SCATTER, MAX_SCATTER, OR_SCATTER
------^
gs_module.f90(258): error #8032: Generic procedure reference has two or more specific procedure with the same type/rank/keyword signature. [GATHER]
call gather (Dest, Src, Mesh, TYPE = EE, TRACE = EE_TRACE, &
---------^
gs_module.f90(293): error #8032: Generic procedure reference has two or more specific procedure with the same type/rank/keyword signature. [GATHER]
call gather (Dest, Src, Mesh, TYPE = EE, TRACE = EE_TRACE, &
---------^
I would welcome any solution to this compiling error (I care less about the warnings).
Thanks,
Adrian
MODULE GS_MODULE
!=======================================================================
! Purpose(s):
!
! Define the interfaces and global variables
! for the gather/scatter support
!
!=======================================================================
use gather_module, only: GATHER
use gs_info_module, only: EN_TRACE, EE_TRACE, EN, EE
use kind_module, only: log_kind
use parameter_module
use scatter_module, only: SUM_SCATTER, MIN_SCATTER, MAX_SCATTER, OR_SCATTER
implicit none
! Private Module
private
! Public procedures
Public :: EE_Gather, EN_Gather, EN_MIN_Gather, EN_MAX_Gather, EN_OR_Gather, &
EN_SUM_Scatter, EN_MIN_Scatter, EN_MAX_Scatter, EN_OR_Scatter, &
EE_GS_INIT, EN_GS_INIT
! Arrays and variables used only inside this module
logical(KIND = log_kind), save, private, pointer, dimension(:,:) :: El_Nbr_MASK
logical(KIND = log_kind), save, private :: EE_MASK_Initialized = .false.
! <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
! Interface blocks
INTERFACE EE_GATHER
!=======================================================================
! Purpose -
! Gather integer cell-centered data from cell face neighbors
! into a integer cell-centered vector of length nfc
!
! Input:
! Mesh - Mesh connectivity structure
! Src - Cell-centered quantity
! Output:
! Dest - Cell-centered vector of length nfc containing
! the value of Src for all face neighbor cells
!
!=======================================================================
MODULE PROCEDURE EE_GATHER_INT
MODULE PROCEDURE EE_GATHER_SINGLE
MODULE PROCEDURE EE_GATHER_DOUBLE
END INTERFACE
!========== EE_GATHER_INT========================================
! This is included by gs_module for the top level gather routines.
! This is the parallel version
SUBROUTINE EE_GATHER_INT (Dest, Src, BOUNDARY)
!=======================================================================
! PURPOSE -
!
!=======================================================================
use gs_info_module, only: EE_TRACE, EE
use kind_module
use mesh_module, only: Mesh
use pgslib_module, only: PGSLib_GS_Trace_Setup_P
implicit none
! Incoming Arguments
integer (int_kind) , intent(IN ), &
dimension (ncells) :: Src
integer (int_kind) , intent( OUT), &
dimension (nfc,ncells) :: Dest
integer (int_kind) , dimension (:), &
POINTER, &
OPTIONAL :: BOUNDARY
! Local Variables
! <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
! Initialize relevant quantities
Dest = 0_int_kind
IF (.NOT. EE_MASK_Initialized) then
EE_MASK_Initialized = .true.
call gs_init_ee_mask()
END IF
IF (.NOT. PGSLib_GS_Trace_Setup_P(EE_Trace)) Call EE_GS_Init()
call gather (Dest, Src, Mesh, TYPE = EE, TRACE = EE_TRACE, &
MASK = El_Nbr_Mask, BOUNDARY = BOUNDARY)
return
END SUBROUTINE EE_GATHER_INT
!========== EE_GATHER_SINGLE========================================
! This is included by gs_module for the top level gather routines.
! This is the parallel version
SUBROUTINE EE_GATHER_SINGLE (Dest, Src, BOUNDARY)
!=======================================================================
! PURPOSE -
!
!=======================================================================
use gs_info_module, only: EE_TRACE, EE
use kind_module
use mesh_module, only: Mesh
use pgslib_module, only: PGSLib_GS_Trace_Setup_P
implicit none
! Incoming Arguments
real (single_kind) , intent(IN ), &
dimension (ncells) :: Src
real (single_kind) , intent( OUT), &
dimension (nfc,ncells) :: Dest
real (single_kind) , dimension (:), &
POINTER, &
OPTIONAL :: BOUNDARY
! Local Variables
! <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
! Initialize relevant quantities
Dest = 0.0_single_kind
IF (.NOT. EE_MASK_Initialized) then
EE_MASK_Initialized = .true.
call gs_init_ee_mask()
END IF
IF (.NOT. PGSLib_GS_Trace_Setup_P(EE_Trace)) Call EE_GS_Init()
call gather (Dest, Src, Mesh, TYPE = EE, TRACE = EE_TRACE, &
MASK = El_Nbr_Mask, BOUNDARY = BOUNDARY)
return
END SUBROUTINE EE_GATHER_SINGLE
!========== EE_GATHER_DOUBLE========================================
! This is included by gs_module for the top level gather routines.
! This is the parallel version
SUBROUTINE EE_GATHER_DOUBLE (Dest, Src, BOUNDARY)
!=======================================================================
! PURPOSE -
!
!=======================================================================
use gs_info_module, only: EE_TRACE, EE
use kind_module
use mesh_module, only: Mesh
use pgslib_module, only: PGSLib_GS_Trace_Setup_P
implicit none
! Incoming Arguments
real (double_kind) , intent(IN ), &
dimension (ncells) :: Src
real (double_kind) , intent( OUT), &
dimension (nfc,ncells) :: Dest
real (double_kind) , dimension (:), &
POINTER, &
OPTIONAL :: BOUNDARY
! Local Variables
! <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
! Initialize relevant quantities
Dest = 0.0_double_kind
IF (.NOT. EE_MASK_Initialized) then
EE_MASK_Initialized = .true.
call gs_init_ee_mask()
END IF
IF (.NOT. PGSLib_GS_Trace_Setup_P(EE_Trace)) Call EE_GS_Init()
call gather (Dest, Src, Mesh, TYPE = EE, TRACE = EE_TRACE, &
MASK = El_Nbr_Mask, BOUNDARY = BOUNDARY)
return
END SUBROUTINE EE_GATHER_DOUBLE
END MODULE GS_MODULE
=================
the other module where gather is defined
MODULE GATHER_MODULE
!=======================================================================
! PURPOSE -
! Routines for gather. These are used by both
! Element<->Element and Element<->Node.
!
!=======================================================================
use gs_info_module
use pgslib_module, ONLY: PGSLib_GS_Struct, PGSLib_Gather_Buffer
implicit none
save
public :: Gather
! Interface blocks
INTERFACE Gather
!=======================================================================
! PURPOSE -
! Gather either cell-centered data or vertex centered data
! into a cell-centered vector of length ShortDim
!
! Input:
! Mesh - Mesh connectivity structure
! Src - Cell or vertex -centered quantity
! Output:
! Dest - Cell-centered vector of length ShortDim containing
! the value of Src for all neighbors
!
!=======================================================================
MODULE PROCEDURE Gather_INT
MODULE PROCEDURE Gather_SINGLE
MODULE PROCEDURE Gather_DOUBLE
END INTERFACE
! <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
CONTAINS
!=======================================================================
! PURPOSE -
! Gather either cell-centered data or vertex centered integer data
! into an integer cell-centered vector of length ShortDim
!=======================================================================
SUBROUTINE GATHER_INT (Dest, Src, Mesh, TYPE, TRACE, BOUNDARY, MASK)
!=======================================================================
! PURPOSE -
! Gather either cell-centered data or vertex centered integer data
! into a integer (int_kind) cell-centered vector of length ShortDim
!=======================================================================
use error_module, only: PUNT
use kind_module
use mesh_module, only: MESH_CONNECTIVITY, CllNgbr, Vrtx
implicit none
! Arguments
integer (int_kind) , dimension(:,:), &
intent(OUT) :: Dest
integer (int_kind) , dimension(:), &
intent(IN) :: Src
type(MESH_CONNECTIVITY), dimension(SIZE(Dest,2)), &
intent(IN) :: Mesh
integer (int_kind) , dimension(:), &
POINTER, &
OPTIONAL :: BOUNDARY
logical(KIND = log_kind), dimension(SIZE(Dest,1), SIZE(Dest,2)), &
intent(IN ), &
OPTIONAL :: MASK
type (COMM_TYPE), intent(IN ) :: TYPE
type (PGSLib_GS_Struct), intent(IN) :: Trace
! Local scalars & arrays
integer(KIND = int_kind) :: f, c
logical(KIND = log_kind) :: PRESENT_MASK, TEMP_BOUNDARY, NEW_BOUNDARY
integer (int_kind), POINTER, dimension(:) :: Supplement_Data
integer (int_kind), dimension(Trace%N_Duplicate) :: Duplicate_Data
! <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
! Initialize relevant quantities
PRESENT_MASK = PRESENT(MASK)
! If BOUNDARY is not passed in, then we have to use a local
! boundaray. If BOUNDARY is passed in, then if it is NULL
TEMP_BOUNDARY = .NOT. PRESENT(BOUNDARY)
! If the BOUNDARY is associated, use it, otherwise get new boundary data.
IF (TEMP_BOUNDARY) THEN
NEW_BOUNDARY = .TRUE.
ELSE
NEW_BOUNDARY = .NOT. ASSOCIATED(BOUNDARY)
ENDIF
IF (NEW_BOUNDARY) THEN
ALLOCATE(Supplement_Data(Trace%N_Supplement))
IF (.NOT. TEMP_BOUNDARY) BOUNDARY => Supplement_Data
! Gather into comm buffer
Duplicate_Data = Src(Trace%Duplicate_Indices)
ELSE
! If we were passed in a boundary, and it was allocated already,
! then us it
IF (.NOT. TEMP_BOUNDARY) Supplement_Data => BOUNDARY
END IF
IF (TEMP_BOUNDARY) DEALLOCATE(Supplement_Data)
return
END SUBROUTINE GATHER_INT
!=======================================================================
! PURPOSE -
! Gather either cell-centered data or vertex centered single data
! into a single cell-centered vector of length ShortDim
!=======================================================================
! This is included for the gather routines.
! This is the parallel version
SUBROUTINE GATHER_SINGLE (Dest, Src, Mesh, TYPE, TRACE, BOUNDARY, MASK)
!=======================================================================
! PURPOSE -
! Gather either cell-centered data or vertex centered integer data
! into a real (single_kind) cell-centered vector of length ShortDim
!=======================================================================
use error_module, only: PUNT
use kind_module
use mesh_module, only: MESH_CONNECTIVITY, CllNgbr, Vrtx
implicit none
! Arguments
real (single_kind) , dimension(:,:), &
intent(OUT) :: Dest
real (single_kind) , dimension(:), &
intent(IN) :: Src
type(MESH_CONNECTIVITY), dimension(SIZE(Dest,2)), &
intent(IN) :: Mesh
real (single_kind) , dimension(:), &
POINTER, &
OPTIONAL :: BOUNDARY
logical(KIND = log_kind), dimension(SIZE(Dest,1), SIZE(Dest,2)), &
intent(IN ), &
OPTIONAL :: MASK
type (COMM_TYPE), intent(IN ) :: TYPE
type (PGSLib_GS_Struct), intent(IN) :: Trace
! Local scalars & arrays
integer(KIND = int_kind) :: f, c
logical(KIND = log_kind) :: PRESENT_MASK, TEMP_BOUNDARY, NEW_BOUNDARY
real (single_kind), POINTER, dimension(:) :: Supplement_Data
real (single_kind), dimension(Trace%N_Duplicate) :: Duplicate_Data
! <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
! Initialize relevant quantities
PRESENT_MASK = PRESENT(MASK)
! If BOUNDARY is not passed in, then we have to use a local
! boundaray. If BOUNDARY is passed in, then if it is NULL
TEMP_BOUNDARY = .NOT. PRESENT(BOUNDARY)
! If the BOUNDARY is associated, use it, otherwise get new boundary data.
IF (TEMP_BOUNDARY) THEN
NEW_BOUNDARY = .TRUE.
ELSE
NEW_BOUNDARY = .NOT. ASSOCIATED(BOUNDARY)
ENDIF
IF (NEW_BOUNDARY) THEN
ALLOCATE(Supplement_Data(Trace%N_Supplement))
IF (.NOT. TEMP_BOUNDARY) BOUNDARY => Supplement_Data
! Gather into comm buffer
Duplicate_Data = Src(Trace%Duplicate_Indices)
ELSE
! If we were passed in a boundary, and it was allocated already,
! then us it
IF (.NOT. TEMP_BOUNDARY) Supplement_Data => BOUNDARY
END IF
IF (TEMP_BOUNDARY) DEALLOCATE(Supplement_Data)
return
END SUBROUTINE GATHER_SINGLE
END MODULE GATHER_MODULE
Link Copied
1 Reply
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Cannot find Gather_DOUBLE anywhere
Reply
Topic Options
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page