16dd63270SBarry Smith#include "petsc/finclude/petscbag.h" 26dd63270SBarry Smith 36dd63270SBarry Smith#if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES) 46dd63270SBarry Smith!DEC$ ATTRIBUTES DLLEXPORT::PetscBagRegisterEnum 56dd63270SBarry Smith#endif 66dd63270SBarry Smith Subroutine PetscBagRegisterEnum(bag, addr, FArray, def, n, h, ierr) 76dd63270SBarry Smith use, intrinsic :: iso_c_binding 86dd63270SBarry Smith use petscbag 96dd63270SBarry Smith implicit none 106dd63270SBarry Smith 116dd63270SBarry Smith PetscBag bag 126dd63270SBarry Smith character(*) n, h 136dd63270SBarry Smith character(*) FArray(*) 146dd63270SBarry Smith PetscEnum :: def 156dd63270SBarry Smith PetscErrorCode, intent(out) :: ierr 166dd63270SBarry Smith PetscReal addr(*) 176dd63270SBarry Smith 186dd63270SBarry Smith Type(C_Ptr), Dimension(:), Pointer :: CArray 196dd63270SBarry Smith character(kind=c_char), pointer :: nullc => null() 206dd63270SBarry Smith PetscInt :: i, Len 216dd63270SBarry Smith Character(kind=C_char, len=256), Dimension(:), Pointer::list1 226dd63270SBarry Smith 236dd63270SBarry Smith do i = 1, 256 24*4820e4eaSBarry Smith if (len_trim(Farray(i)) == 0) then 256dd63270SBarry Smith Len = i - 1 266dd63270SBarry Smith goto 100 276dd63270SBarry Smith end if 28*4820e4eaSBarry Smith if (len_trim(Farray(i)) > 255) then 296dd63270SBarry Smith ierr = PETSC_ERR_ARG_OUTOFRANGE 306dd63270SBarry Smith return 316dd63270SBarry Smith end if 326dd63270SBarry Smith end do 336dd63270SBarry Smith ierr = PETSC_ERR_ARG_OUTOFRANGE 346dd63270SBarry Smith return 356dd63270SBarry Smith 366dd63270SBarry Smith100 continue 376dd63270SBarry Smith 386dd63270SBarry Smith Allocate (list1(Len), stat=ierr) 39*4820e4eaSBarry Smith if (ierr /= 0) return 406dd63270SBarry Smith Allocate (CArray(Len + 1), stat=ierr) 41*4820e4eaSBarry Smith if (ierr /= 0) return 426dd63270SBarry Smith 436dd63270SBarry Smith do i = 1, Len 446dd63270SBarry Smith list1(i) = trim(FArray(i))//C_NULL_CHAR 456dd63270SBarry Smith CArray(i) = c_loc(list1(i)) 466dd63270SBarry Smith end do 476dd63270SBarry Smith 486dd63270SBarry Smith CArray(Len + 1) = c_loc(nullc) 496dd63270SBarry Smith call PetscBagRegisterEnumPrivate(bag, addr, CArray, def, n, h, ierr) 506dd63270SBarry Smith DeAllocate (CArray) 516dd63270SBarry Smith DeAllocate (list1) 526dd63270SBarry Smith End Subroutine 53