Date: 2015-10-02T22:00:36+00:00

Actual source code: optionenum.F
petsc-3.6.2 2015-10-02
Report Typos and Errors

      2: #include "petsc/finclude/petscsysdef.h"

      4:       Subroutine PetscOptionsGetEnum(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:       PetscErrorCode,intent(out)  :: ierr

     14:       Type(C_Ptr),Dimension(:),Pointer :: CArray
     15:       character(kind=c_char),pointer   :: nullc => null()
     16:       PetscInt   :: i,Len
     17:       Character(kind=C_char,len=99),Dimension(:),Pointer::list1

     19:       Len=0
     20:       do i=1,100
     21:         if (len_trim(Farray(i)) .eq. 0) then
     22:           Len = i-1
     23:           goto 100
     24:         endif
     25:       enddo
     26:  100  continue

     28:       Allocate(list1(Len),stat=ierr);
     29:       Allocate(CArray(Len+1),stat=ierr)
     30:       do i=1,Len
     31:          list1(i) = trim(FArray(i))//C_NULL_CHAR
     32:       enddo

     34:       CArray = (/(c_loc(list1(i)),i=1,Len),c_loc(nullc)/)
     35:       call PetscOptionsGetEnumPrivate(pre,name,CArray,opt,set,ierr)
     36:       DeAllocate(CArray)
     37:       DeAllocate(list1)
     38:       End Subroutine