1#include "petsc/finclude/petscbag.h" 2 3#if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES) 4!DEC$ ATTRIBUTES DLLEXPORT::PetscBagRegisterEnum 5#endif 6 subroutine PetscBagRegisterEnum(bag, addr, FArray, def, n, h, ierr) 7 use, intrinsic :: iso_c_binding 8 use petscbag 9 implicit none 10 11 PetscBag bag 12 character(*) n, h 13 character(*) FArray(*) 14 PetscEnum :: def 15 PetscErrorCode, intent(out) :: ierr 16 PetscReal addr(*) 17 18 type(C_Ptr), dimension(:), pointer :: CArray 19 character(kind=c_char), pointer :: nullc => null() 20 PetscInt :: i, Len 21 character(kind=C_char, len=256), dimension(:), pointer::list1 22 23 do i = 1, 256 24 if (len_trim(Farray(i)) == 0) then 25 Len = i - 1 26 goto 100 27 end if 28 if (len_trim(Farray(i)) > 255) then 29 ierr = PETSC_ERR_ARG_OUTOFRANGE 30 return 31 end if 32 end do 33 ierr = PETSC_ERR_ARG_OUTOFRANGE 34 return 35 36100 continue 37 38 allocate (list1(Len), stat=ierr) 39 if (ierr /= 0) return 40 allocate (CArray(Len + 1), stat=ierr) 41 if (ierr /= 0) return 42 43 do i = 1, Len 44 list1(i) = trim(FArray(i))//C_NULL_CHAR 45 CArray(i) = c_loc(list1(i)) 46 end do 47 48 CArray(Len + 1) = c_loc(nullc) 49 call PetscBagRegisterEnumPrivate(bag, addr, CArray, def, n, h, ierr) 50 deallocate (CArray) 51 deallocate (list1) 52 end subroutine 53