Actual source code: optionenum.F
petsc-3.10.5 2019-03-28
Report Typos and Errors

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

      4: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
      5: !DEC$ ATTRIBUTES DLLEXPORT::PetscOptionsGetEnum
      6: #endif

      8:       Subroutine PetscOptionsGetEnum(po,pre,name,FArray,opt,set,ierr)
      9:       use,intrinsic :: iso_c_binding
     10:       use petscsysdef
     11:       implicit none

     13:       character(*)                pre,name
     14:       character(*)                FArray(*)
     15:       PetscEnum                   :: opt
     16:       PetscBool                   :: set
     17:       PetscOptions                :: po
     18:       PetscErrorCode,intent(out)  :: ierr

     20:       Type(C_Ptr),Dimension(:),Pointer :: CArray
     21:       character(kind=c_char),pointer   :: nullc => null()
     22:       PetscInt   :: i,Len
     23:       Character(kind=C_char,len=99),Dimension(:),Pointer::list1

     25:       Len=0
     26:       do i=1,100
     27:         if (len_trim(Farray(i)) .eq. 0) then
     28:           Len = i-1
     29:           goto 100
     30:         endif
     31:       enddo
     32:  100  continue

     34:       Allocate(list1(Len),stat=ierr)
     35:       if (ierr .ne. 0) return
     36:       Allocate(CArray(Len+1),stat=ierr)
     37:       if (ierr .ne. 0) return
     38:       do i=1,Len
     39:          list1(i) = trim(FArray(i))//C_NULL_CHAR
     40:       enddo

     42:       CArray = (/(c_loc(list1(i)),i=1,Len),c_loc(nullc)/)
     43:       call PetscOptionsGetEnumPrivate(po,pre,name,CArray,opt,set,ierr)
     44:       DeAllocate(CArray)
     45:       DeAllocate(list1)
     46:       End Subroutine