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