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)) .eq. 0) then 25 Len = i-1 26 goto 100 27 endif 28 if (len_trim(Farray(i)) .gt. 255) then 29 ierr = PETSC_ERR_ARG_OUTOFRANGE 30 return 31 endif 32 enddo 33 ierr = PETSC_ERR_ARG_OUTOFRANGE 34 return 35 36 100 continue 37 38 Allocate(list1(Len),stat=ierr) 39 if (ierr .ne. 0) return 40 Allocate(CArray(Len+1),stat=ierr) 41 if (ierr .ne. 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 enddo 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