#include "petsc/finclude/petscbag.h" #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES) !DEC$ ATTRIBUTES DLLEXPORT::PetscBagRegisterEnum #endif subroutine PetscBagRegisterEnum(bag, addr, FArray, def, n, h, ierr) use, intrinsic :: iso_c_binding use petscbag implicit none PetscBag bag character(*) n, h character(*) FArray(*) PetscEnum :: def PetscErrorCode, intent(out) :: ierr PetscReal addr(*) type(C_Ptr), dimension(:), pointer :: CArray character(kind=c_char), pointer :: nullc => null() PetscInt :: i, Len character(kind=C_char, len=256), dimension(:), pointer::list1 do i = 1, 256 if (len_trim(Farray(i)) == 0) then Len = i - 1 goto 100 end if if (len_trim(Farray(i)) > 255) then ierr = PETSC_ERR_ARG_OUTOFRANGE return end if end do ierr = PETSC_ERR_ARG_OUTOFRANGE return 100 continue allocate (list1(Len), stat=ierr) if (ierr /= 0) return allocate (CArray(Len + 1), stat=ierr) if (ierr /= 0) return do i = 1, Len list1(i) = trim(FArray(i))//C_NULL_CHAR CArray(i) = c_loc(list1(i)) end do CArray(Len + 1) = c_loc(nullc) call PetscBagRegisterEnumPrivate(bag, addr, CArray, def, n, h, ierr) deallocate (CArray) deallocate (list1) end subroutine