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 goto 100 30 end if 31 end do 32100 continue 33 34 allocate (list1(Len), stat=ierr) 35 if (ierr /= 0) return 36 allocate (CArray(Len + 1), stat=ierr) 37 if (ierr /= 0) return 38 do i = 1, Len 39 list1(i) = trim(FArray(i))//C_NULL_CHAR 40 CArray(i) = c_loc(list1(i)) 41 end do 42 43 CArray(Len + 1) = c_loc(nullc) 44 call PetscOptionsGetEnumPrivate(po, pre, name, CArray, opt, set, ierr) 45 deallocate (CArray) 46 deallocate (list1) 47end subroutine 48 49subroutine PetscOptionsEnum(opt, text, man, Flist, curr, ivalue, set, ierr) 50 use, intrinsic :: iso_c_binding 51 use petscsysdef 52 implicit none 53 54 character(*) opt, text, man 55 character(*) Flist(*) 56 PetscEnum :: curr, ivalue 57 PetscBool :: set 58 PetscErrorCode, intent(out) :: ierr 59 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 64 65 Len = 0 66 do i = 1, 100 67 if (len_trim(Flist(i)) == 0) then 68 Len = i - 1 69 goto 100 70 end if 71 end do 72100 continue 73 74 allocate (list1(Len), stat=ierr) 75 if (ierr /= 0) return 76 allocate (CArray(Len + 1), stat=ierr) 77 if (ierr /= 0) return 78 do i = 1, Len 79 list1(i) = trim(Flist(i))//C_NULL_CHAR 80 CArray(i) = c_loc(list1(i)) 81 end do 82 83 CArray(Len + 1) = c_loc(nullc) 84 call PetscOptionsEnumPrivate(opt, text, man, CArray, curr, ivalue, set, ierr) 85 86 deallocate (CArray) 87 deallocate (list1) 88end subroutine PetscOptionsEnum 89