1*6dd63270SBarry Smith#include "petsc/finclude/petscsys.h" 2*6dd63270SBarry Smith 3*6dd63270SBarry Smith#if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES) 4*6dd63270SBarry Smith!DEC$ ATTRIBUTES DLLEXPORT::PetscOptionsGetEnum 5*6dd63270SBarry Smith!DEC$ ATTRIBUTES DLLEXPORT::PetscOptionsEnum 6*6dd63270SBarry Smith#endif 7*6dd63270SBarry Smith 8*6dd63270SBarry SmithSubroutine PetscOptionsGetEnum(po,pre,name,FArray,opt,set,ierr) 9*6dd63270SBarry Smith use,intrinsic :: iso_c_binding 10*6dd63270SBarry Smith use petscsysdef 11*6dd63270SBarry Smith implicit none 12*6dd63270SBarry Smith 13*6dd63270SBarry Smith character(*) pre,name 14*6dd63270SBarry Smith character(*) FArray(*) 15*6dd63270SBarry Smith PetscEnum :: opt 16*6dd63270SBarry Smith PetscBool :: set 17*6dd63270SBarry Smith PetscOptions :: po 18*6dd63270SBarry Smith PetscErrorCode,intent(out) :: ierr 19*6dd63270SBarry Smith 20*6dd63270SBarry Smith Type(C_Ptr),Dimension(:),Pointer :: CArray 21*6dd63270SBarry Smith character(kind=c_char),pointer :: nullc => null() 22*6dd63270SBarry Smith PetscInt :: i,Len 23*6dd63270SBarry Smith Character(kind=C_char,len=99),Dimension(:),Pointer::list1 24*6dd63270SBarry Smith 25*6dd63270SBarry Smith Len=0 26*6dd63270SBarry Smith do i=1,100 27*6dd63270SBarry Smith if (len_trim(Farray(i)) .eq. 0) then 28*6dd63270SBarry Smith Len = i-1 29*6dd63270SBarry Smith goto 100 30*6dd63270SBarry Smith endif 31*6dd63270SBarry Smith enddo 32*6dd63270SBarry Smith100 continue 33*6dd63270SBarry Smith 34*6dd63270SBarry Smith Allocate(list1(Len),stat=ierr) 35*6dd63270SBarry Smith if (ierr .ne. 0) return 36*6dd63270SBarry Smith Allocate(CArray(Len+1),stat=ierr) 37*6dd63270SBarry Smith if (ierr .ne. 0) return 38*6dd63270SBarry Smith do i=1,Len 39*6dd63270SBarry Smith list1(i) = trim(FArray(i))//C_NULL_CHAR 40*6dd63270SBarry Smith CArray(i) = c_loc(list1(i)) 41*6dd63270SBarry Smith enddo 42*6dd63270SBarry Smith 43*6dd63270SBarry Smith CArray(Len+1) = c_loc(nullc) 44*6dd63270SBarry Smith call PetscOptionsGetEnumPrivate(po,pre,name,CArray,opt,set,ierr) 45*6dd63270SBarry Smith DeAllocate(CArray) 46*6dd63270SBarry Smith DeAllocate(list1) 47*6dd63270SBarry SmithEnd Subroutine 48*6dd63270SBarry Smith 49*6dd63270SBarry SmithSubroutine PetscOptionsEnum(opt,text,man,Flist,curr,ivalue,set,ierr) 50*6dd63270SBarry Smith use,intrinsic :: iso_c_binding 51*6dd63270SBarry Smith use petscsysdef 52*6dd63270SBarry Smith implicit none 53*6dd63270SBarry Smith 54*6dd63270SBarry Smith character(*) opt,text,man 55*6dd63270SBarry Smith character(*) Flist(*) 56*6dd63270SBarry Smith PetscEnum :: curr,ivalue 57*6dd63270SBarry Smith PetscBool :: set 58*6dd63270SBarry Smith PetscErrorCode,intent(out) :: ierr 59*6dd63270SBarry Smith 60*6dd63270SBarry Smith Type(C_Ptr),Dimension(:),Pointer :: CArray 61*6dd63270SBarry Smith character(kind=c_char),pointer :: nullc => null() 62*6dd63270SBarry Smith PetscInt :: i,Len 63*6dd63270SBarry Smith Character(kind=C_char,len=99),Dimension(:),Pointer::list1 64*6dd63270SBarry Smith 65*6dd63270SBarry Smith Len=0 66*6dd63270SBarry Smith do i=1,100 67*6dd63270SBarry Smith if (len_trim(Flist(i)) .eq. 0) then 68*6dd63270SBarry Smith Len = i-1 69*6dd63270SBarry Smith goto 100 70*6dd63270SBarry Smith endif 71*6dd63270SBarry Smith enddo 72*6dd63270SBarry Smith100 continue 73*6dd63270SBarry Smith 74*6dd63270SBarry Smith Allocate(list1(Len),stat=ierr) 75*6dd63270SBarry Smith if (ierr .ne. 0) return 76*6dd63270SBarry Smith Allocate(CArray(Len+1),stat=ierr) 77*6dd63270SBarry Smith if (ierr .ne. 0) return 78*6dd63270SBarry Smith do i=1,Len 79*6dd63270SBarry Smith list1(i) = trim(Flist(i))//C_NULL_CHAR 80*6dd63270SBarry Smith CArray(i) = c_loc(list1(i)) 81*6dd63270SBarry Smith enddo 82*6dd63270SBarry Smith 83*6dd63270SBarry Smith CArray(Len+1) = c_loc(nullc) 84*6dd63270SBarry Smith call PetscOptionsEnumPrivate(opt,text,man,CArray,curr,ivalue,set,ierr) 85*6dd63270SBarry Smith 86*6dd63270SBarry Smith DeAllocate(CArray) 87*6dd63270SBarry Smith DeAllocate(list1) 88*6dd63270SBarry SmithEnd Subroutine PetscOptionsEnum 89