Actual source code: optionenum.F

petsc-3.12.5 2020-03-29
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