1#include "petsc/finclude/petscsys.h" 2 3#if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES) 4!DEC$ ATTRIBUTES DLLEXPORT::PetscOptionsGetEnum 5!DEC$ ATTRIBUTES DLLEXPORT::PetscOptionsEnum 6#endif 7 8subroutine PetscOptionsGetEnum(po, pre, name, FArray, opt, set, ierr) 9 use, intrinsic :: iso_c_binding 10 use petscsysdef 11 implicit none 12 13 character(*) pre, name 14 character(*) FArray(*) 15 PetscEnum :: opt 16 PetscBool :: set 17 PetscOptions :: po 18 PetscErrorCode, intent(out) :: ierr 19 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 24 25 Len = 0 26 do i = 1, 100 27 if (len_trim(Farray(i)) == 0) then 28 Len = i - 1 29 exit 30 end if 31 end do 32 33 allocate (list1(Len), stat=ierr) 34 if (ierr /= 0) return 35 allocate (CArray(Len + 1), stat=ierr) 36 if (ierr /= 0) return 37 do i = 1, Len 38 list1(i) = trim(FArray(i))//C_NULL_CHAR 39 CArray(i) = c_loc(list1(i)) 40 end do 41 42 CArray(Len + 1) = c_loc(nullc) 43 call PetscOptionsGetEnumPrivate(po, pre, name, CArray, opt, set, ierr) 44 deallocate (CArray) 45 deallocate (list1) 46end subroutine 47 48subroutine PetscOptionsEnum(opt, text, man, Flist, curr, ivalue, set, ierr) 49 use, intrinsic :: iso_c_binding 50 use petscsysdef 51 implicit none 52 53 character(*) opt, text, man 54 character(*) Flist(*) 55 PetscEnum :: curr, ivalue 56 PetscBool :: set 57 PetscErrorCode, intent(out) :: ierr 58 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 63 64 Len = 0 65 do i = 1, 100 66 if (len_trim(Flist(i)) == 0) then 67 Len = i - 1 68 exit 69 end if 70 end do 71 72 allocate (list1(Len), stat=ierr) 73 if (ierr /= 0) return 74 allocate (CArray(Len + 1), stat=ierr) 75 if (ierr /= 0) return 76 do i = 1, Len 77 list1(i) = trim(Flist(i))//C_NULL_CHAR 78 CArray(i) = c_loc(list1(i)) 79 end do 80 81 CArray(Len + 1) = c_loc(nullc) 82 call PetscOptionsEnumPrivate(opt, text, man, CArray, curr, ivalue, set, ierr) 83 84 deallocate (CArray) 85 deallocate (list1) 86end subroutine PetscOptionsEnum 87