Actual source code: optionenum.F
petsc-3.7.1 2016-05-15
Report Typos and Errors

      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