Actual source code: optionenum.F90

  1: #include "petsc/finclude/petscsys.h"

  3: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
  4: !DEC$ ATTRIBUTES DLLEXPORT::PetscOptionsGetEnum
  5: !DEC$ ATTRIBUTES DLLEXPORT::PetscOptionsEnum
  6: #endif

  8: subroutine PetscOptionsGetEnum(po, pre, name, FArray, opt, set, ierr)
  9:   use, intrinsic :: iso_c_binding
 10:   use petscsysdef
 11:   implicit none

 13:   character(*) pre, name
 14:   character(*) FArray(*)
 15:   PetscEnum                   :: opt
 16:   PetscBool                   :: set
 17:   PetscOptions                :: po
 18:   PetscErrorCode, intent(out)  :: ierr

 20:   type(C_Ptr), dimension(:), pointer :: CArray
 21:   character(kind=c_char), pointer   :: nullc => null()
 22:   PetscInt   :: i, Len
 23:   character(kind=C_char, len=99), dimension(:), pointer::list1

 25:   Len = 0
 26:   do i = 1, 100
 27:     if (len_trim(Farray(i)) == 0) then
 28:       Len = i - 1
 29:       exit
 30:     end if
 31:   end do

 33:   allocate (list1(Len), stat=ierr)
 34:   if (ierr /= 0) return
 35:   allocate (CArray(Len + 1), stat=ierr)
 36:   if (ierr /= 0) return
 37:   do i = 1, Len
 38:     list1(i) = trim(FArray(i))//C_NULL_CHAR
 39:     CArray(i) = c_loc(list1(i))
 40:   end do

 42:   CArray(Len + 1) = c_loc(nullc)
 43:   call PetscOptionsGetEnumPrivate(po, pre, name, CArray, opt, set, ierr)
 44:   deallocate (CArray)
 45:   deallocate (list1)
 46: end subroutine

 48: subroutine PetscOptionsEnum(opt, text, man, Flist, curr, ivalue, set, ierr)
 49:   use, intrinsic :: iso_c_binding
 50:   use petscsysdef
 51:   implicit none

 53:   character(*) opt, text, man
 54:   character(*) Flist(*)
 55:   PetscEnum                   :: curr, ivalue
 56:   PetscBool                   :: set
 57:   PetscErrorCode, intent(out)  :: ierr

 59:   type(C_Ptr), dimension(:), pointer :: CArray
 60:   character(kind=c_char), pointer   :: nullc => null()
 61:   PetscInt   :: i, Len
 62:   character(kind=C_char, len=99), dimension(:), pointer::list1

 64:   Len = 0
 65:   do i = 1, 100
 66:     if (len_trim(Flist(i)) == 0) then
 67:       Len = i - 1
 68:       exit
 69:     end if
 70:   end do

 72:   allocate (list1(Len), stat=ierr)
 73:   if (ierr /= 0) return
 74:   allocate (CArray(Len + 1), stat=ierr)
 75:   if (ierr /= 0) return
 76:   do i = 1, Len
 77:     list1(i) = trim(Flist(i))//C_NULL_CHAR
 78:     CArray(i) = c_loc(list1(i))
 79:   end do

 81:   CArray(Len + 1) = c_loc(nullc)
 82:   call PetscOptionsEnumPrivate(opt, text, man, CArray, curr, ivalue, set, ierr)

 84:   deallocate (CArray)
 85:   deallocate (list1)
 86: end subroutine PetscOptionsEnum