Actual source code: optionenum.F
petsc-3.3-p7 2013-05-11
2: #include "finclude/petscdef.h"
3: Subroutine PetscOptionsGetEnum(pre,name,FArray,opt,set,ierr)
4: use,intrinsic :: iso_c_binding
5: implicit none
7: character(*) pre,name
8: character(*) FArray(*)
9: PetscEnum :: opt
10: PetscBool :: set
11: PetscErrorCode,intent(out) :: ierr
13: Type(C_Ptr),Dimension(:),Pointer :: CArray
14: character(kind=c_char),pointer :: nullc => null()
15: PetscInt :: i,Len
16: Character(kind=C_char,len=99),Dimension(:),Pointer::list1
18: Len=0
19: do i=1,100
20: if (len_trim(Farray(i)) .eq. 0) then
21: Len = i-1
22: goto 100
23: endif
24: enddo
25: 100 continue
27: Allocate(list1(Len),stat=ierr);
28: Allocate(CArray(Len+1),stat=ierr)
29: do i=1,Len
30: list1(i) = trim(FArray(i))//C_NULL_CHAR
31: enddo
33: CArray = (/(c_loc(list1(i)),i=1,Len),c_loc(nullc)/)
34: call PetscOptionsGetEnumPrivate(pre,name,CArray,opt,set,ierr)
35: DeAllocate(CArray)
36: DeAllocate(list1)
37: End Subroutine