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:       goto 100
 30:     end if
 31:   end do
 32: 100 continue

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

 43:   CArray(Len + 1) = c_loc(nullc)
 44:   call PetscOptionsGetEnumPrivate(po, pre, name, CArray, opt, set, ierr)
 45:   DeAllocate (CArray)
 46:   DeAllocate (list1)
 47: End Subroutine

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

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

 60:   Type(C_Ptr), Dimension(:), Pointer :: CArray
 61:   character(kind=c_char), pointer   :: nullc => null()
 62:   PetscInt   :: i, Len
 63:   Character(kind=C_char, len=99), Dimension(:), Pointer::list1

 65:   Len = 0
 66:   do i = 1, 100
 67:     if (len_trim(Flist(i)) == 0) then
 68:       Len = i - 1
 69:       goto 100
 70:     end if
 71:   end do
 72: 100 continue

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

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

 86:   DeAllocate (CArray)
 87:   DeAllocate (list1)
 88: End Subroutine PetscOptionsEnum