Actual source code: optionenum.F
petsc-3.9.4 2018-09-11
2: #include "petsc/finclude/petscsys.h"
4: Subroutine PetscOptionsGetEnum(po,pre,name,FArray,opt,set,ierr)
5: use,intrinsic :: iso_c_binding
6: use petscsysdef
7: implicit none
9: character(*) pre,name
10: character(*) FArray(*)
11: PetscEnum :: opt
12: PetscBool :: set
13: PetscOptions :: po
14: PetscErrorCode,intent(out) :: ierr
16: Type(C_Ptr),Dimension(:),Pointer :: CArray
17: character(kind=c_char),pointer :: nullc => null()
18: PetscInt :: i,Len
19: Character(kind=C_char,len=99),Dimension(:),Pointer::list1
21: Len=0
22: do i=1,100
23: if (len_trim(Farray(i)) .eq. 0) then
24: Len = i-1
25: goto 100
26: endif
27: enddo
28: 100 continue
30: Allocate(list1(Len),stat=ierr)
31: if (ierr .ne. 0) return
32: Allocate(CArray(Len+1),stat=ierr)
33: if (ierr .ne. 0) return
34: do i=1,Len
35: list1(i) = trim(FArray(i))//C_NULL_CHAR
36: enddo
38: CArray = (/(c_loc(list1(i)),i=1,Len),c_loc(nullc)/)
39: call PetscOptionsGetEnumPrivate(po,pre,name,CArray,opt,set,ierr)
40: DeAllocate(CArray)
41: DeAllocate(list1)
42: End Subroutine