Actual source code: optionenum.F90

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

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

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

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

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

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

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

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

 48: Subroutine PetscOptionsEnum(opt,text,man,Flist,curr,ivalue,set,ierr)
 49:   use,intrinsic :: iso_c_binding
 50:   use petscsysdef
 51:   implicit none

 53:   character(*)                opt,text,man
 54:   character(*)                Flist(*)
 55:   PetscEnum                   :: curr,ivalue
 56:   PetscBool                   :: set
 57:   PetscErrorCode,intent(out)  :: ierr

 59:   Type(C_Ptr),Dimension(:),Pointer :: CArray
 60:   character(kind=c_char),pointer   :: nullc => null()
 61:   PetscInt   :: i,Len
 62:   Character(kind=C_char,len=99),Dimension(:),Pointer::list1

 64:   Len=0
 65:   do i=1,100
 66:     if (len_trim(Flist(i)) .eq. 0) then
 67:       Len = i-1
 68:       goto 100
 69:     endif
 70:   enddo
 71: 100  continue

 73:   Allocate(list1(Len),stat=ierr)
 74:   if (ierr .ne. 0) return
 75:   Allocate(CArray(Len+1),stat=ierr)
 76:   if (ierr .ne. 0) return
 77:   do i=1,Len
 78:       list1(i) = trim(Flist(i))//C_NULL_CHAR
 79:       CArray(i) = c_loc(list1(i))
 80:   enddo

 82:   CArray(Len+1) = c_loc(nullc)
 83:   call PetscOptionsEnumPrivate(opt,text,man,CArray,curr,ivalue,set,ierr)

 85:   DeAllocate(CArray)
 86:   DeAllocate(list1)
 87: End Subroutine PetscOptionsEnum