Fortran templates
in [Fortran]
|
From: James Van Buskirk on 18 Apr 2008 14:31 "relaxmike" <michael.baudin(a)gmail.com> wrote in message news:5be1dfe2-56d4-4a32-82bf-1a0c302def89(a)k37g2000hsf.googlegroups.com... > I still try to experiment the idea, so here is a sample > full demonstration of the pre-processing way. > Here is the file "test2_template.F90" : > subroutine _READFILE_DATA_NAME ( current_data_line , myvalue , > status ) > implicit none > character ( len = * ) , intent(in) :: current_data_line > _DATATYPE , intent (out) :: myvalue > integer, intent(out) :: status > status = 0 > read ( current_data_line , * , err = 100 , end = 100) myvalue > return > 100 continue > status = 1 > end subroutine _READFILE_DATA_NAME > And this is the test file : > > module m_moduletest2 > interface readfile_data > module procedure readfile_data_logical > module procedure readfile_data_integer > end interface readfile_data > contains > #define _DATATYPE logical > #define _READFILE_DATA_NAME readfile_data_logical > #include "test2_template.F90" > #undef _DATATYPE > #undef _READFILE_DATA_NAME > #define _DATATYPE integer > #define _READFILE_DATA_NAME readfile_data_integer > #include "test2_template.F90" > #undef _DATATYPE > #undef _READFILE_DATA_NAME > end module m_moduletest2 > program test2 > use m_moduletest2 > character (len=200) :: current_data_line > integer :: myintvalue1 > logical :: mylogicalvalue1 > integer :: status > current_data_line = "1" > call readfile_data ( current_data_line , myintvalue1 , status ) > write ( * , * ) "status:", status > write ( * , * ) "Integer : ", myintvalue1 > current_data_line = ".true." > call readfile_data ( current_data_line , mylogicalvalue1 , status ) > write ( * , * ) "status:", status > write ( * , * ) "Logical : ", mylogicalvalue1 > end program test2 OK, how about: C:\gfortran\clf\template_war>type test3_template.i90 private public readfile_data interface readfile_data module procedure READFILE_DATA_NAME end interface readfile_data contains subroutine READFILE_DATA_NAME(current_data_line,Qmyvalue,status) character(len=*), intent(in) :: current_data_line intent (out) :: Qmyvalue integer, intent(out) :: status status = 0 read(current_data_line, *, err=100 , end=100) Qmyvalue return 100 continue status = 1 end subroutine READFILE_DATA_NAME C:\gfortran\clf\template_war>type test3.f90 module logical_mod implicit logical (Q) include 'test3_template.i90' end module logical_mod module integer_mod implicit integer (Q) include 'test3_template.i90' end module integer_mod module m_moduletest3 use logical_mod use integer_mod end module m_moduletest3 program test3 use m_moduletest3 character (len=200) :: current_data_line integer :: myintvalue1 logical :: mylogicalvalue1 integer :: status current_data_line = "1" call readfile_data(current_data_line, myintvalue1, status) write(*, *) "status:", status write(*, *) "Integer : ", myintvalue1 current_data_line = ".true." call readfile_data(current_data_line, mylogicalvalue1, status ) write(*, *) "status:", status write(*, *) "Logical : ", mylogicalvalue1 end program test3 C:\gfortran\clf\template_war>C:\gfortran\win64\bin\x86_64-pc-mingw32-gfortran te st3.f90 -otest3 C:\gfortran\clf\template_war>test3 status: 0 Integer : 1 status: 0 Logical : T > I tried to use "include" only statements without pre-processing, > and that lead to a source code which I am not proud of. > But the "C void pointer" idea leads to the following source. > The "void" idea is managed with a derived type containing all > possible fortran basic data types. > The "pointer" is the class name, a string containing "integer", > or "logical", depending on the type to manage. > This is the source code : > module m_moduletest4 > type :: DATATYPE > integer :: value_integer > logical :: value_logical > character ( len = 200 ) :: classname > end type DATATYPE > contains > subroutine readfile_data ( current_data_line , classname , myvalue , > status ) > implicit none > character ( len = * ) , intent(in) :: current_data_line > character ( len = * ) , intent(in) :: classname > type ( DATATYPE ) , intent(out) :: myvalue > integer, intent(out) :: status > status = 0 > myvalue % classname = classname > select case ( classname ) > case ( "integer" ) > read ( current_data_line , * , err = 100 , end = 100) myvalue % > value_integer > case ( "logical" ) > read ( current_data_line , * , err = 100 , end = 100) myvalue % > value_logical > case default > write(6,*) "Bad classname." > end select > return > 100 continue > status = 1 > end subroutine readfile_data > subroutine printdata ( myvalue ) > implicit none > type ( DATATYPE ) , intent(in) :: myvalue > write ( * , * ) trim(myvalue % classname) , ":" > select case ( myvalue % classname ) > case ( "integer" ) > write ( * , * ) myvalue % value_integer > case ( "logical" ) > write ( * , * ) myvalue % value_logical > case default > write(6,*) "Bad classname." > end select > end subroutine printdata > end module m_moduletest4 > program test4 > use m_moduletest4 > character (len=200) :: current_data_line > type ( DATATYPE ) :: myvalue > integer :: status > current_data_line = "1" > call readfile_data ( current_data_line , "integer", myvalue , > status ) > write ( * , * ) "status:", status > call printdata ( myvalue ) > current_data_line = ".true." > call readfile_data ( current_data_line , "logical" , myvalue , > status ) > write ( * , * ) "status:", status > call printdata ( myvalue ) > end program test4 Isn't this an exercise in shooting fish in a barrel? C:\gfortran\clf\template_war>type test6.f90 module m_moduletest6 use ISO_C_BINDING, only: C_PTR, C_LOC, C_F_POINTER implicit none private C_PTR, C_LOC, C_F_POINTER type :: DATATYPE type(C_PTR) value character ( len = 200 ) :: classname end type DATATYPE contains subroutine readfile_data(current_data_line,classname,myvalue,status) implicit none character(len=*) , intent(in) :: current_data_line character(len=*) , intent(in) :: classname type(DATATYPE), intent(out) :: myvalue integer, intent(out) :: status integer, pointer :: pi4 logical, pointer :: pL4 status = 0 myvalue%classname = classname select case(classname) case ("integer") allocate(pi4) read(current_data_line, *, err=101, end=101) pi4 myvalue%value = C_LOC(pi4) return 101 deallocate(pi4) case("logical") allocate(pL4) read(current_data_line, *, err=102, end=102) pL4 myvalue%value = C_LOC(pL4) return 102 deallocate(pL4) case default write(6,*) "Bad classname." end select return 100 continue status = 1 end subroutine readfile_data subroutine printdata(myvalue) implicit none type(DATATYPE), intent(in) :: myvalue integer, pointer :: pi4 logical, pointer :: pL4 write(* ,*) trim(myvalue%classname), ":" select case(myvalue%classname) case("integer") call C_F_POINTER(myvalue%value, pi4) write(* ,*) pi4 case("logical") call C_F_POINTER(myvalue%value, pL4) write(* ,*) pL4 case default write(6,*) "Bad classname." end select end subroutine printdata end module m_moduletest6 program test6 use m_moduletest6 character (len=200) :: current_data_line type(DATATYPE) :: myvalue integer :: status current_data_line = "1" call readfile_data(current_data_line, "integer", myvalue, status) write(*, *) "status:", status call printdata(myvalue) current_data_line = ".true." call readfile_data(current_data_line, "logical", myvalue, status) write(* ,*) "status:", status call printdata(myvalue) end program test6 C:\gfortran\clf\template_war>C:\gfortran\win64\bin\x86_64-pc-mingw32-gfortran te st6.f90 -otest6 C:\gfortran\clf\template_war>test6 status: 0 integer: 1 status: 0 logical: T > - the abstract data type cannot handle user-defined derived-types. > The pre-processing system allows to define whatever type you want to, > without any complication in the client source code. > This is not the case with the hand-crafted "pointer to everything" > abstract data type. Not the case, see my examples above. > But you may suggest another way ? Naturally. -- write(*,*) transfer((/17.392111325966148d0,6.5794487871554595D-85, & 6.0134700243160014d-154/),(/'x'/)); end
From: Charles Coldwell on 20 Apr 2008 15:10 relaxmike <michael.baudin(a)gmail.com> writes: > One example of the problems solved by C++ templates is to > have a sorting source code which is able to manage for any > data type, including integers, reals, or even abstract data > types. > > I currently know 3 ways of dealing with templates in fortran, > even if none of them is included in any fortran norm > (and none of them is detailed in a fortran book, to my knowledge) : > - pre-processing macros, > - clever use of the "include" statement, > - m4 macros. You forgot "callbacks": ! Fortran 95 implementation of the quicksort algorithm. This ! subroutine does not directly touch the array it sorts; rather it ! relies on the two callbacks "compare" and "exchange" for that. Code ! inspired by R. Sedgewick, "Algorithms in C" and correspondence with ! Glen Herrmannsfeldt. subroutine quicksort(n, compare, exchange) implicit none integer, intent(in) :: n ! the length of the implied array ! The compare function must return an integer that is ! greater than zero if element(i) > element(j) ! equal to zero if element(i) = element(j) ! less than zero if element(i) < element(j) interface integer function compare(i,j) integer, intent(in) :: i, j end function compare end interface ! The exchange subroutine exchanges the elements at locations i and j. interface subroutine exchange(i,j) integer, intent(in) :: i, j end subroutine exchange end interface integer, dimension(2,n) :: stack integer :: sptr, left, right, pivot sptr = 1 call push(1, n) do while(pop(left, right)) if (left .ge. right) cycle pivot = partition(left, right) if (pivot .gt. (left+right)/2) then call push(left,pivot-1) call push(pivot+1,right) else call push(pivot+1,right) call push(left,pivot-1) end if end do return contains subroutine push(l, r) integer, intent(in) :: l, r stack(1, sptr) = l stack(2, sptr) = r sptr = sptr + 1 end subroutine push logical function pop(l, r) integer, intent(out) :: l, r if (sptr .gt. 1) then sptr = sptr - 1 l = stack(1, sptr) r = stack(2, sptr) pop = .true. else pop = .false. end if end function pop integer function partition(l,r) integer, intent(in) :: l, r integer :: i, j i = l j = r - 1 do do while (compare(i,r) .lt. 0) i = i+1 end do do while (compare(j,r) .gt. 0) if (j .eq. l) exit j = j-1 end do if (i .ge. j) exit call exchange(i,j) end do call exchange(i,r) partition = i end function partition end subroutine quicksort Chip -- Charles M. "Chip" Coldwell "Turn on, log in, tune out" GPG Key ID: 852E052F GPG Key Fingerprint: 77E5 2B51 4907 F08A 7E92 DE80 AFA9 9A8F 852E 052F
From: relaxmike on 21 Apr 2008 08:27 Thanks for these suggestions. I must say that the method based on implicit statements is very clever, and, based only on fortran statements, allows to minimize the code duplication. But is it possible to declare something like this : module data_mod type MYDATA character(len=20) :: string end type MYDATA implicit type(MYDATA) (Q) include 'test3_template.i90' end module data_mod I don't think so, which shows that the method cannot be extended to abstract data types. But funny though. The method based on "ISO_C_BINDING, only: C_PTR, C_LOC, C_F_POINTER" is interesting but leads to code duplication. If I where to use "ISO_C_BINDING", I think that I would use the C++ templates, and only define in fortran the interface to the C++ source code. All in all, it would be much more simpler if the fortran language include a "template" feature in the core, which may be done, in 2043, may be... Michaël
From: Richard Maine on 21 Apr 2008 10:52 relaxmike <michael.baudin(a)gmail.com> wrote: > I must say that the method based on implicit statements is > very clever, and, based only on fortran statements, allows > to minimize the code duplication. But is it possible to > declare something like this : > > module data_mod > type MYDATA > character(len=20) :: string > end type MYDATA > implicit type(MYDATA) (Q) > include 'test3_template.i90' > end module data_mod > > I don't think so, which shows that the method cannot be extended > to abstract data types. Yes, it is possible to do something like that. The only problem with the above is one of ordering. Implicit statements have to come quite early in a scoping unit, before pretty much anything other than USE statements. I forget whether it would be ok to just swap the order or whether a different ordering constraint prevents that. If that doesn't work, defining the derived type in a separate module, which you USE here, would work. Derived types are allowed in implicit statements, I'm sure. However, I can't really recommend that approach. The well-known error-proneness of implicit typing is greatly magnified in the presence of derived types, modules, and host association. -- Richard Maine | Good judgement comes from experience; email: last name at domain . net | experience comes from bad judgement. domain: summertriangle | -- Mark Twain
From: James Van Buskirk on 21 Apr 2008 12:43
"relaxmike" <michael.baudin(a)gmail.com> wrote in message news:ffd371af-6da7-44b4-b431-d2e189af5978(a)c19g2000prf.googlegroups.com... > I must say that the method based on implicit statements is > very clever, and, based only on fortran statements, allows > to minimize the code duplication. But is it possible to > declare something like this : > module data_mod > type MYDATA > character(len=20) :: string > end type MYDATA > implicit type(MYDATA) (Q) > include 'test3_template.i90' > end module data_mod > I don't think so, which shows that the method cannot be extended > to abstract data types. But funny though. The method is indeed clever. Wish I had thought of it myself, but someone else suggested it in clf. As Richard pointed out of course you can do this: C:\gfortran\clf\template_war>type test3_template.i90 private public readfile_data interface readfile_data module procedure READFILE_DATA_NAME end interface readfile_data contains subroutine READFILE_DATA_NAME(current_data_line,Qmyvalue,status) character(len=*), intent(in) :: current_data_line intent (out) :: Qmyvalue integer, intent(out) :: status status = 0 read(current_data_line, *, err=100 , end=100) Qmyvalue return 100 continue status = 1 end subroutine READFILE_DATA_NAME C:\gfortran\clf\template_war>type test7.f90 module data_mod implicit none type MYDATA character(len=20) string end type MYDATA end module data_mod module logical_mod implicit logical (Q) include 'test3_template.i90' end module logical_mod module integer_mod implicit integer (Q) include 'test3_template.i90' end module integer_mod module MYDATA_mod use data_mod implicit type(MYDATA) (Q) include 'test3_template.i90' end module MYDATA_mod module m_moduletest3 use logical_mod use integer_mod use MYDATA_mod end module m_moduletest3 program test3 use data_mod use m_moduletest3 character (len=200) :: current_data_line integer :: myintvalue1 logical :: mylogicalvalue1 type(MYDATA) :: myMYDATAvalue1 integer :: status current_data_line = "1" call readfile_data(current_data_line, myintvalue1, status) write(*, *) "status:", status write(*, *) "Integer : ", myintvalue1 current_data_line = ".true." call readfile_data(current_data_line, mylogicalvalue1, status ) write(*, *) "status:", status write(*, *) "Logical : ", mylogicalvalue1 current_data_line = "'Hello from James'" call readfile_data(current_data_line, myMYDATAvalue1, status ) write(*, *) "status:", status write(*, *) "MYDATA : ", myMYDATAvalue1 end program test3 C:\gfortran\clf\template_war>c:\gfortran\win64\bin\x86_64-pc-mingw32-gfortran te st7.f90 -otest7 C:\gfortran\clf\template_war>test7 status: 0 Integer : 1 status: 0 Logical : T status: 0 MYDATA : Hello from James -- write(*,*) transfer((/17.392111325966148d0,6.5794487871554595D-85, & 6.0134700243160014d-154/),(/'x'/)); end |