Commits

BarryFSmith committed 6fe6d30 Merge

Merge branch 'barry/add-vecgetarray-fortran-derived-type' into next

Comments (0)

Files changed (4)

src/vec/vec/examples/tutorials/ex21.c

+#include <petscvec.h>
+#include <../src/sys/f90-src/f90impl.h>
+
+#if defined(PETSC_HAVE_FORTRAN_CAPS)
+#define vecgetarraymystruct_            VECGETARRAYMYSTRUCT
+#define vecrestorearraymystruct_        VECRESTOREARRAYMYSTRUCT
+#define f90array1dcreatemystruct_       F90ARRAY1DCREATEMYSTRUCT
+#define f90array1daccessmystruct_       F90ARRAY1DACCESSMYSTRUCT
+#define f90array1ddestroymystruct_      F90ARRAY1DDESTROYMYSTRUCT
+#define f90array1dgetaddrmystruct_      F90ARRAY1DGETADDRMYSTRUCT
+#elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
+#define vecgetarraymystruct_            vecgetarraymystruct
+#define vecrestorearraymystruct_        vecrestorearraymystruct
+#define f90array1dcreatemystruct_       f90array1dcreatemystruct
+#define f90array1daccessmystruct_       f90array1daccessmystruct
+#define f90array1ddestroymystruct_      f90array1ddestroymystruct
+#define f90array1dgetaddrmystruc_       f90array1dgetaddrmystruct
+#endif
+
+PETSC_EXTERN void PETSC_STDCALL f90array1dcreatemystruct_(void *,PetscInt *,PetscInt *,F90Array1d * PETSC_F90_2PTR_PROTO_NOVAR);
+PETSC_EXTERN void PETSC_STDCALL f90array1daccessmystruct_(F90Array1d*,void** PETSC_F90_2PTR_PROTO_NOVAR);
+PETSC_EXTERN void PETSC_STDCALL f90array1ddestroymystruct_(F90Array1d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
+
+PETSC_EXTERN void PETSC_STDCALL f90array1dgetaddrmystruct_(void *array, PetscFortranAddr *address)
+{
+  *address = (PetscFortranAddr)array;
+}
+
+PETSC_EXTERN void PETSC_STDCALL vecgetarraymystruct_(Vec *x,F90Array1d *ptr,int *__ierr PETSC_F90_2PTR_PROTO(ptrd))
+{
+  PetscScalar *fa;
+  PetscInt    len;
+  if (!ptr) {
+    *__ierr = PetscError(((PetscObject)*x)->comm,__LINE__,PETSC_FUNCTION_NAME,__FILE__,__SDIR__,PETSC_ERR_ARG_BADPTR,PETSC_ERROR_INITIAL,"ptr==NULL");
+    return;
+  }
+  *__ierr = VecGetArray(*x,&fa);      if (*__ierr) return;
+  *__ierr = VecGetLocalSize(*x,&len); if (*__ierr) return;
+  PetscInt one = 1;
+  f90array1dcreatemystruct_(fa,&one,&len,ptr PETSC_F90_2PTR_PARAM(ptrd));
+}
+
+PETSC_EXTERN void PETSC_STDCALL vecrestorearraymystruct_(Vec *x,F90Array1d *ptr,int *__ierr PETSC_F90_2PTR_PROTO(ptrd))
+{
+  PetscScalar *fa;
+  f90array1daccessmystruct_(ptr,(void**)&fa PETSC_F90_2PTR_PARAM(ptrd));
+  f90array1ddestroymystruct_(ptr PETSC_F90_2PTR_PARAM(ptrd));
+  *__ierr = VecRestoreArray(*x,&fa);
+}
+

src/vec/vec/examples/tutorials/ex21f90.F

+!
+!
+!    Demonstrates how one may access entries of a PETSc Vec as if it was an array of Fortran derived types
+!
+!
+! -----------------------------------------------------------------------
+#include <finclude/petscsysdef.h>
+#include <finclude/petscvecdef.h>
+
+      module mymodule
+      type MyStruct
+        sequence
+        PetscScalar :: a,b,c
+      end type MyStruct
+      end module
+
+!
+!  These routines are used internally by the C functions VecGetArrayMyStruct() and VecRestoreArrayMyStruct()
+!  Because Fortran requires "knowing" exactly what derived types the pointers to point too, these have to be 
+!  customized for exactly the derived type in question
+!
+      subroutine F90Array1dCreateMyStruct(array,start,len,ptr)
+      use mymodule
+      implicit none
+#include <finclude/petscsys.h>
+      PetscInt start,len
+      type(MyStruct), target ::                                               &
+     &             array(start:start+len-1)
+      type(MyStruct), pointer :: ptr(:)
+
+      ptr => array
+      end subroutine
+
+      subroutine F90Array1dAccessMyStruct(ptr,address)
+      use mymodule
+      implicit none
+#include <finclude/petscsys.h>
+      type(MyStruct), pointer :: ptr(:)
+      PetscFortranAddr address
+      PetscInt start
+
+      start = lbound(ptr,1)
+      call F90Array1dGetAddrMyStruct(ptr(start),address)
+      end subroutine
+
+      subroutine F90Array1dDestroyMyStruct(ptr)
+      use mymodule
+      implicit none
+#include <finclude/petscsys.h>
+      type(MyStruct), pointer :: ptr(:)
+
+      nullify(ptr)
+      end subroutine
+
+
+      program main
+      use mymodule
+      implicit none
+
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+!                    Include files
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+!
+!  The following include statements are required for Fortran programs
+!  that use PETSc vectors:
+!     petscsys.h       - base PETSc routines
+!     petscvec.h    - vectors
+!     petscvec.h90  - to allow access to Fortran90 features of vectors
+!
+!  Additional include statements may be needed if using additional
+!  PETSc routines in a Fortran program, e.g.,
+!     petscviewer.h - viewers
+!     petscis.h     - index sets
+!
+#include <finclude/petscsys.h>
+#include <finclude/petscviewer.h>
+#include <finclude/petscvec.h>
+#include <finclude/petscvec.h90>
+
+!
+!   These two routines are defined in ex21.c they create the Fortran pointer to the derived type
+!
+      Interface
+        Subroutine VecGetArrayMyStruct(v,array,ierr)
+          use mymodule
+          type(MyStruct), pointer :: array(:)
+          PetscErrorCode ierr
+          Vec     v
+        End Subroutine
+      End Interface
+
+      Interface
+        Subroutine VecRestoreArrayMyStruct(v,array,ierr)
+          use mymodule
+          type(MyStruct), pointer :: array(:)
+          PetscErrorCode ierr
+          Vec     v
+        End Subroutine
+      End Interface
+
+!
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+!                   Variable declarations
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+!
+!  Variables:
+!     x, y, w - vectors
+!     z       - array of vectors
+!
+      Vec              x,y
+      type(MyStruct),  pointer :: xarray(:)
+      PetscInt         n
+      PetscErrorCode   ierr
+      PetscBool        flg
+      integer          i
+
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+!                 Beginning of program
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+      call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
+      n     = 30
+
+      call PetscOptionsGetInt(PETSC_NULL_CHARACTER,'-n',n,flg,ierr)
+      call VecCreate(PETSC_COMM_WORLD,x,ierr)
+      call VecSetSizes(x,PETSC_DECIDE,n,ierr)
+      call VecSetFromOptions(x,ierr)
+      call VecDuplicate(x,y,ierr)
+
+      call VecGetArrayMyStruct(x,xarray,ierr)
+      do i=1,10
+      xarray(i)%a = i
+      xarray(i)%b = 100*i
+      xarray(i)%c = 10000*i
+      enddo
+
+      call VecRestoreArrayMyStruct(x,xarray,ierr)
+      call VecView(x,PETSC_VIEWER_STDOUT_SELF,ierr)
+      call VecGetArrayMyStruct(x,xarray,ierr)
+      do i = 1 , 10
+        write(*,*) xarray(i)%a,xarray(i)%b,xarray(i)%c
+      end do
+      call VecRestoreArrayMyStruct(x,xarray,ierr)
+
+
+      call VecDestroy(x,ierr)
+      call VecDestroy(y,ierr)
+      call PetscFinalize(ierr)
+
+      end
+

src/vec/vec/examples/tutorials/makefile

 MANSEC           = Vec
 LOCDIR		 = src/vec/vec/examples/tutorials/
 EXAMPLESC	 = ex1.c ex2.c ex3.c ex5.c ex6.c ex7.c ex8.c ex9.c ex10.c \
-                ex11.c ex12.c ex15.c ex16.c  ex18.c ex19.c ex42.c ex42a.c
-EXAMPLESF	 = ex1f.F ex1f90.F ex2f.F ex3f.F ex4f.F ex4f90.F ex7f.F ex9f.F ex11f.F ex14f.F ex20f90.F90
+                ex11.c ex12.c ex15.c ex16.c  ex18.c ex19.c ex42.c ex42a.c ex21.c
+EXAMPLESF	 = ex1f.F ex1f90.F ex2f.F ex3f.F ex4f.F ex4f90.F ex7f.F ex9f.F ex11f.F ex14f.F ex20f90.F90 ex21f90.F
 
 include ${PETSC_DIR}/conf/variables
 include ${PETSC_DIR}/conf/rules
 	-${FLINKER} -o ex20f90 ex20f90.o ${PETSC_VEC_LIB}
 	${RM} -f ex20f90.o
 
+ex21f90: ex21f90.o ex21.o  chkopts
+	-${FLINKER} -o ex21f90 ex21f90.o ex21.o ${PETSC_VEC_LIB}
+	${RM} -f ex21f90.o ex21.o
+
 ex42: ex42.o chkopts
 	-${CLINKER} -o ex42 ex42.o ${PETSC_SNES_LIB}
 	${RM} ex42.o
 	   if (${DIFF} output/ex20f90_1.out ex20f90_1.tmp) then true; \
 	   else echo ${PWD} ; echo "Possible problem with with ex20f90_1, diffs above \n========================================="; fi;\
 	   ${RM} -f ex20f90_1.tmp
+runex21f90:
+	-@${MPIEXEC} -n 1 ./ex21f90 > ex21f90_1.tmp 2>&1;\
+	   if (${DIFF} output/ex21f90_1.out ex21f90_1.tmp) then true; \
+	   else echo ${PWD} ; echo "Possible problem with with ex21f90_1, diffs above \n========================================="; fi;\
+	   ${RM} -f ex21f90_1.tmp
 
 TESTEXAMPLES_C		    = ex1.PETSc runex1 runex1_2 ex1.rm  \
                               ex2.PETSc runex2 ex2.rm ex5.PETSc runex5 runex5_2 ex5.rm ex6.PETSc \
 TESTEXAMPLES_C_X	    = ex3.PETSc runex3 ex3.rm
 TESTEXAMPLES_FORTRAN	    = ex1f.PETSc runex1f runex1f_2 ex1f.rm ex2f.PETSc runex2f ex2f.rm ex4f.PETSc \
                               runex4f ex4f.rm ex3f.PETSc ex3f.rm ex7.PETSc runex7 ex7.rm ex9f.PETSc runex9f \
-                              runex9f_2 ex9f.rm ex11f.PETSc runex11f ex11f.rm ex14f.PETSc ex14f.rm
+                              runex9f_2 ex9f.rm ex11f.PETSc runex11f ex11f.rm ex14f.PETSc ex14f.rm ex21f90.PETSc runex21f90 ex21f90.rm
 TESTEXAMPLES_C_X_MPIUNI   = ex1.PETSc runex1 ex1.rm ex5.PETSc runex5 ex5.rm
 TESTEXAMPLES_FORTRAN_MPIUNI = ex1f.PETSc runex1f ex1f.rm ex4f.PETSc runex4f ex4f.rm ex7.PETSc ex7.rm
 TESTEXAMPLES_F90	    = ex1f90.PETSc runex1f90 ex1f90.rm ex20f90.PETSc runex20f90 ex20f90.rm ex4f90.PETSc runex4f90 ex4f90.rm

src/vec/vec/examples/tutorials/output/ex21f90_1.out

+Vec Object: 1 MPI processes
+  type: seq
+1
+100
+10000
+2
+200
+20000
+3
+300
+30000
+4
+400
+40000
+5
+500
+50000
+6
+600
+60000
+7
+700
+70000
+8
+800
+80000
+9
+900
+90000
+10
+1000
+100000
+   1.0000000000000000        100.00000000000000        10000.000000000000     
+   2.0000000000000000        200.00000000000000        20000.000000000000     
+   3.0000000000000000        300.00000000000000        30000.000000000000     
+   4.0000000000000000        400.00000000000000        40000.000000000000     
+   5.0000000000000000        500.00000000000000        50000.000000000000     
+   6.0000000000000000        600.00000000000000        60000.000000000000     
+   7.0000000000000000        700.00000000000000        70000.000000000000     
+   8.0000000000000000        800.00000000000000        80000.000000000000     
+   9.0000000000000000        900.00000000000000        90000.000000000000     
+   10.000000000000000        1000.0000000000000        100000.00000000000