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: !DEC$ ATTRIBUTES DLLEXPORT::PetscOptionsEnum
  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:       CArray(i) = c_loc(list1(i))
 41:   enddo

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

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

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

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

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

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

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

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