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