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