mp_type_make_r Function

private function mp_type_make_r(ptr, vector_descriptor, index_descriptor) result(type_descriptor)

Arguments

TypeIntentOptionalAttributesName
real(kind=real_4), DIMENSION(:), POINTER:: ptr
integer, intent(in), optional DIMENSION(2):: vector_descriptor
type(mp_indexing_meta_type), intent(in), optional :: index_descriptor

Return Value type(mp_type_descriptor_type)


Contents

Source Code


Source Code

      FUNCTION mp_type_make_r (ptr, &
                                           vector_descriptor, index_descriptor) &
         RESULT(type_descriptor)
         REAL(kind=real_4), DIMENSION(:), POINTER                  :: ptr
         INTEGER, DIMENSION(2), INTENT(IN), OPTIONAL       :: vector_descriptor
         TYPE(mp_indexing_meta_type), INTENT(IN), OPTIONAL :: index_descriptor
         TYPE(mp_type_descriptor_type)                     :: type_descriptor

         CHARACTER(LEN=*), PARAMETER :: routineN = 'mp_type_make_r'

         INTEGER :: ierr

         ierr = 0
         NULLIFY (type_descriptor%subtype)
         type_descriptor%length = SIZE(ptr)
#if defined(__parallel)
         type_descriptor%type_handle = MPI_REAL
         CALL MPI_Get_address(ptr, type_descriptor%base, ierr)
         IF (ierr /= 0) &
            DBCSR_ABORT("MPI_Get_address @ "//routineN)
#else
         type_descriptor%type_handle = 1
#endif
         type_descriptor%vector_descriptor(1:2) = 1
         type_descriptor%has_indexing = .FALSE.
         type_descriptor%data_r => ptr
         IF (PRESENT(vector_descriptor) .OR. PRESENT(index_descriptor)) THEN
            DBCSR_ABORT(routineN//": Vectors and indices NYI")
         END IF
      END FUNCTION mp_type_make_r