[cig-commits] commit: gfortran fixes and waf adjustments
Mercurial
hg at geodynamics.org
Fri Oct 21 17:03:30 PDT 2011
changeset: 35:de8630bbadef
user: Walter Landry <wlandry at caltech.edu>
date: Thu Oct 20 12:03:36 2011 -0700
files: export.f90 getopt.f90 getopt_m.f90 include.f90 input.f90 types.f90
description:
gfortran fixes and waf adjustments
diff -r 617b7e74fbfb -r de8630bbadef export.f90
--- a/export.f90 Thu Oct 20 12:03:14 2011 -0700
+++ b/export.f90 Thu Oct 20 12:03:36 2011 -0700
@@ -17,7 +17,7 @@
! along with RELAX. If not, see <http://www.gnu.org/licenses/>.
!-----------------------------------------------------------------------
-#include 'include.f90'
+#include "include.f90"
MODULE export
@@ -1034,10 +1034,10 @@ END SUBROUTINE exportcreep
+sx1*dx1/2, -sx2*dx2/2, sx3*dx3/2, &
+sx1*dx1/2, +sx2*dx2/2, sx3*dx3/2, &
-sx1*dx1/2, +sx2*dx2/2, sx3*dx3/2, &
- -sx1*dx1/2, -sx2*dx2/2, 0, &
- +sx1*dx1/2, -sx2*dx2/2, 0, &
- +sx1*dx1/2, +sx2*dx2/2, 0, &
- -sx1*dx1/2, +sx2*dx2/2, 0
+ -sx1*dx1/2, -sx2*dx2/2, 0.0, &
+ +sx1*dx1/2, -sx2*dx2/2, 0.0, &
+ +sx1*dx1/2, +sx2*dx2/2, 0.0, &
+ -sx1*dx1/2, +sx2*dx2/2, 0.0
WRITE (15,'(" </DataArray>")')
WRITE (15,'(" </Points>")')
WRITE (15,'(" <Polys>")')
@@ -1826,14 +1826,14 @@ END SUBROUTINE exportcreep
! fault edge coordinates
WRITE (15,'(24ES11.2)') &
- x1-d(1)*W/2.d0-s(1)*L/2.d0-n(1)*T/2.d0, x2-d(2)*W/2.d0-s(2)*L/2.d0-n(2)*T/2.d0, x3-d(3)*W/2-s(3)*L/2-n(3)*T/2.d0, &
- x1-d(1)*W/2.d0+s(1)*L/2.d0-n(1)*T/2.d0, x2-d(2)*W/2.d0+s(2)*L/2.d0-n(2)*T/2.d0, x3-d(3)*W/2+s(3)*L/2-n(3)*T/2.d0, &
- x1+d(1)*W/2.d0+s(1)*L/2.d0-n(1)*T/2.d0, x2+d(2)*W/2.d0+s(2)*L/2.d0-n(2)*T/2.d0, x3+d(3)*W/2+s(3)*L/2-n(3)*T/2.d0, &
- x1+d(1)*W/2.d0-s(1)*L/2.d0-n(1)*T/2.d0, x2+d(2)*W/2.d0-s(2)*L/2.d0-n(2)*T/2.d0, x3+d(3)*W/2-s(3)*L/2-n(3)*T/2.d0, &
- x1+d(1)*W/2.d0-s(1)*L/2.d0+n(1)*T/2.d0, x2+d(2)*W/2.d0-s(2)*L/2.d0+n(2)*T/2.d0, x3+d(3)*W/2-s(3)*L/2+n(3)*T/2.d0, &
- x1-d(1)*W/2.d0-s(1)*L/2.d0+n(1)*T/2.d0, x2-d(2)*W/2.d0-s(2)*L/2.d0+n(2)*T/2.d0, x3-d(3)*W/2-s(3)*L/2+n(3)*T/2.d0, &
- x1-d(1)*W/2.d0+s(1)*L/2.d0+n(1)*T/2.d0, x2-d(2)*W/2.d0+s(2)*L/2.d0+n(2)*T/2.d0, x3-d(3)*W/2+s(3)*L/2+n(3)*T/2.d0, &
- x1+d(1)*W/2.d0+s(1)*L/2.d0+n(1)*T/2.d0, x2+d(2)*W/2.d0+s(2)*L/2.d0+n(2)*T/2.d0, x3+d(3)*W/2+s(3)*L/2+n(3)*T/2.d0
+ x1-d(1)*W/2.d0-s(1)*L/2.d0-n(1)*T/2.d0, x2-d(2)*W/2.d0-s(2)*L/2.d0-n(2)*T/2.d0,x3-d(3)*W/2-s(3)*L/2-n(3)*T/2.d0, &
+ x1-d(1)*W/2.d0+s(1)*L/2.d0-n(1)*T/2.d0, x2-d(2)*W/2.d0+s(2)*L/2.d0-n(2)*T/2.d0,x3-d(3)*W/2+s(3)*L/2-n(3)*T/2.d0, &
+ x1+d(1)*W/2.d0+s(1)*L/2.d0-n(1)*T/2.d0, x2+d(2)*W/2.d0+s(2)*L/2.d0-n(2)*T/2.d0,x3+d(3)*W/2+s(3)*L/2-n(3)*T/2.d0, &
+ x1+d(1)*W/2.d0-s(1)*L/2.d0-n(1)*T/2.d0, x2+d(2)*W/2.d0-s(2)*L/2.d0-n(2)*T/2.d0,x3+d(3)*W/2-s(3)*L/2-n(3)*T/2.d0, &
+ x1+d(1)*W/2.d0-s(1)*L/2.d0+n(1)*T/2.d0, x2+d(2)*W/2.d0-s(2)*L/2.d0+n(2)*T/2.d0,x3+d(3)*W/2-s(3)*L/2+n(3)*T/2.d0, &
+ x1-d(1)*W/2.d0-s(1)*L/2.d0+n(1)*T/2.d0, x2-d(2)*W/2.d0-s(2)*L/2.d0+n(2)*T/2.d0,x3-d(3)*W/2-s(3)*L/2+n(3)*T/2.d0, &
+ x1-d(1)*W/2.d0+s(1)*L/2.d0+n(1)*T/2.d0, x2-d(2)*W/2.d0+s(2)*L/2.d0+n(2)*T/2.d0,x3-d(3)*W/2+s(3)*L/2+n(3)*T/2.d0, &
+ x1+d(1)*W/2.d0+s(1)*L/2.d0+n(1)*T/2.d0, x2+d(2)*W/2.d0+s(2)*L/2.d0+n(2)*T/2.d0,x3+d(3)*W/2+s(3)*L/2+n(3)*T/2.d0
WRITE (15,'(" </DataArray>")')
WRITE (15,'(" </Points>")')
@@ -2019,8 +2019,8 @@ END SUBROUTINE exportcreep
! open file for mixed binary/ascii writing in VTK legacy format
OPEN(UNIT=15,FILE=vcfilename,form='UNFORMATTED',ACCESS='SEQUENTIAL', &
- ACTION='WRITE',CONVERT='BIG_ENDIAN',RECORDTYPE='STREAM', &
- BUFFERED='YES',IOSTAT=iostatus)
+ ACTION='WRITE',CONVERT='BIG_ENDIAN', &
+ IOSTAT=iostatus)
IF (iostatus>0) THEN
WRITE_DEBUG_INFO
PRINT '(a)', vcfilename
@@ -2088,8 +2088,8 @@ END SUBROUTINE exportcreep
! open file for mixed binary/ascii writing in VTK legacy format
OPEN(UNIT=15,FILE=vcfilename,form='UNFORMATTED',ACCESS='SEQUENTIAL', &
- ACTION='WRITE',CONVERT='BIG_ENDIAN',RECORDTYPE='STREAM', &
- BUFFERED='YES',IOSTAT=iostatus)
+ ACTION='WRITE',CONVERT='BIG_ENDIAN', &
+ IOSTAT=iostatus)
IF (iostatus>0) THEN
WRITE_DEBUG_INFO
PRINT '(a)', vcfilename
diff -r 617b7e74fbfb -r de8630bbadef getopt.f90
--- a/getopt.f90 Thu Oct 20 12:03:14 2011 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,233 +0,0 @@
-! ------------------------------------------------------------
-! Copyright 2008 by Mark Gates
-!
-! This program is free software; you can redistribute or modify it under
-! the terms of the GNU general public license (GPL), version 2 or later.
-!
-! This program is distributed in the hope that it will be useful, but
-! WITHOUT ANY WARRANTY; without even the implied warranty of
-! merchantability or fitness for a particular purpose.
-!
-! If you wish to incorporate this into non-GPL software, please contact
-! me regarding licensing terms.
-!
-! ------------------------------------------------------------
-! Fortran 95 getopt() and getopt_long(), similar to those in standard C library.
-!
-! ch = getopt( optstring, [longopts] )
-! Returns next option character from command line arguments.
-! If an option is not recognized, it returns '?'.
-! If no options are left, it returns a null character, char(0).
-!
-! optstring contains characters that are recognized as options.
-! If a character is followed by a colon, then it takes a required argument.
-! For example, "x" recognizes "-x", while "x:" recognizes "-x arg" or "-xarg".
-!
-! optopt is set to the option character, even if it isn't recognized.
-! optarg is set to the option's argument.
-! optind has the index of the next argument to process. Initially optind=1.
-! Errors are printed by default. Set opterr=.false. to suppress them.
-!
-! Grouped options are allowed, so "-abc" is the same as "-a -b -c".
-!
-! If longopts is present, it is an array of type(option_s), where each entry
-! describes one long option.
-!
-! type option_s
-! character(len=80) :: name
-! logical :: has_arg
-! character :: val
-! end type
-!
-! The name field is the option name, without the leading -- double dash.
-! Set the has_arg field to true if it requires an argument, false if not.
-! The val field is returned. Typically this is set to the corresponding short
-! option, so short and long options can be processed together. (But there
-! is no requirement that every long option has a short option, or vice-versa.)
-!
-! -----
-! EXAMPLE
-! program test
-! use getopt_m
-! implicit none
-! character:: ch
-! type(option_s):: opts(2)
-! opts(1) = option_s( "alpha", .false., 'a' )
-! opts(2) = option_s( "beta", .true., 'b' )
-! do
-! select case( getopt( "ab:c", opts ))
-! case( char(0))
-! exit
-! case( 'a' )
-! print *, 'option alpha/a'
-! case( 'b' )
-! print *, 'option beta/b=', optarg
-! case( '?' )
-! print *, 'unknown option ', optopt
-! stop
-! case default
-! print *, 'unhandled option ', optopt, ' (this is a bug)'
-! end select
-! end do
-! end program test
-!
-! Differences from C version:
-! - when options are finished, C version returns -1 instead of char(0),
-! and thus stupidly requires an int instead of a char.
-! - does not support optreset
-! - does not support "--" as last argument
-! - if no argument, optarg is blank, not NULL
-! - argc and argv are implicit
-!
-! Differences for long options:
-! - optional argument to getopt(), rather than separate function getopt_long()
-! - has_arg is logical, and does not support optional_argument
-! - does not support flag field (and thus always returns val)
-! - does not support longindex
-! - does not support "--opt=value" syntax, only "--opt value"
-! - knows the length of longopts, so does not need an empty last record
-
-module getopt_m
- implicit none
- character(len=80):: optarg
- character:: optopt
- integer:: optind=1
- logical:: opterr=.true.
-
- type option_s
- character(len=80) :: name
- logical :: has_arg
- character :: val
- end type
-
- ! grpind is index of next option within group; always >= 2
- integer, private:: grpind=2
-
-contains
-
-! ----------------------------------------
-! Return str(i:j) if 1 <= i <= j <= len(str),
-! else return empty string.
-! This is needed because Fortran standard allows but doesn't *require* short-circuited
-! logical AND and OR operators. So this sometimes fails:
-! if ( i < len(str) .and. str(i+1:i+1) == ':' ) then
-! but this works:
-! if ( substr(str, i+1, i+1) == ':' ) then
-
-character function substr( str, i, j )
- ! arguments
- character(len=*), intent(in):: str
- integer, intent(in):: i, j
-
- if ( 1 <= i .and. i <= j .and. j <= len(str)) then
- substr = str(i:j)
- else
- substr = ''
- endif
-end function substr
-
-
-! ----------------------------------------
-character function getopt( optstring, longopts )
- ! arguments
- character(len=*), intent(in):: optstring
- type(option_s), intent(in), optional:: longopts(:)
-
- ! local variables
- character(len=80):: arg
-
- optarg = ''
- if ( optind > iargc()) then
- getopt = char(0)
- endif
-
- call getarg( optind, arg )
- if ( present( longopts ) .and. arg(1:2) == '--' ) then
- getopt = process_long( longopts, arg )
- elseif ( arg(1:1) == '-' ) then
- getopt = process_short( optstring, arg )
- else
- getopt = char(0)
- endif
-end function getopt
-
-
-! ----------------------------------------
-character function process_long( longopts, arg )
- ! arguments
- type(option_s), intent(in):: longopts(:)
- character(len=*), intent(in):: arg
-
- ! local variables
- integer:: i
-
- ! search for matching long option
- optind = optind + 1
- do i = 1, size(longopts)
- if ( arg(3:) == longopts(i)%name ) then
- optopt = longopts(i)%val
- process_long = optopt
- if ( longopts(i)%has_arg ) then
- if ( optind <= iargc()) then
- call getarg( optind, optarg )
- optind = optind + 1
- elseif ( opterr ) then
- WRITE (0,'(a,a,a)') "error: option '", trim(arg), "' requires an argument"
- endif
- endif
- return
- endif
- end do
- ! else not found
- process_long = '?'
- if ( opterr ) then
- WRITE (0,'(a,a,a)'), "error: unrecognized option '", trim(arg), "'"
- endif
-end function process_long
-
-
-! ----------------------------------------
-character function process_short( optstring, arg )
- ! arguments
- character(len=*), intent(in):: optstring, arg
-
- ! local variables
- integer:: i, arglen
-
- arglen = len( trim( arg ))
- optopt = arg(grpind:grpind)
- process_short = optopt
-
- i = index( optstring, optopt )
- if ( i == 0 ) then
- ! unrecognized option
- process_short = '?'
- if ( opterr ) then
- print '(a,a,a)', "Error: unrecognized option '-", optopt, "'"
- endif
- endif
- if ( i > 0 .and. substr( optstring, i+1, i+1 ) == ':' ) then
- ! required argument
- optind = optind + 1
- if ( arglen > grpind ) then
- ! -xarg, return remainder of arg
- optarg = arg(grpind+1:arglen)
- elseif ( optind <= iargc()) then
- ! -x arg, return next arg
- call getarg( optind, optarg )
- optind = optind + 1
- elseif ( opterr ) then
- WRITE (0,'(a,a,a)') "error: option '-", optopt, "' requires an argument"
- endif
- grpind = 2
- elseif ( arglen > grpind ) then
- ! no argument (or unrecognized), go to next option in argument (-xyz)
- grpind = grpind + 1
- else
- ! no argument (or unrecognized), go to next argument
- grpind = 2
- optind = optind + 1
- endif
-end function process_short
-
-end module getopt_m
diff -r 617b7e74fbfb -r de8630bbadef getopt_m.f90
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/getopt_m.f90 Thu Oct 20 12:03:36 2011 -0700
@@ -0,0 +1,233 @@
+! ------------------------------------------------------------
+! Copyright 2008 by Mark Gates
+!
+! This program is free software; you can redistribute or modify it under
+! the terms of the GNU general public license (GPL), version 2 or later.
+!
+! This program is distributed in the hope that it will be useful, but
+! WITHOUT ANY WARRANTY; without even the implied warranty of
+! merchantability or fitness for a particular purpose.
+!
+! If you wish to incorporate this into non-GPL software, please contact
+! me regarding licensing terms.
+!
+! ------------------------------------------------------------
+! Fortran 95 getopt() and getopt_long(), similar to those in standard C library.
+!
+! ch = getopt( optstring, [longopts] )
+! Returns next option character from command line arguments.
+! If an option is not recognized, it returns '?'.
+! If no options are left, it returns a null character, char(0).
+!
+! optstring contains characters that are recognized as options.
+! If a character is followed by a colon, then it takes a required argument.
+! For example, "x" recognizes "-x", while "x:" recognizes "-x arg" or "-xarg".
+!
+! optopt is set to the option character, even if it isn't recognized.
+! optarg is set to the option's argument.
+! optind has the index of the next argument to process. Initially optind=1.
+! Errors are printed by default. Set opterr=.false. to suppress them.
+!
+! Grouped options are allowed, so "-abc" is the same as "-a -b -c".
+!
+! If longopts is present, it is an array of type(option_s), where each entry
+! describes one long option.
+!
+! type option_s
+! character(len=80) :: name
+! logical :: has_arg
+! character :: val
+! end type
+!
+! The name field is the option name, without the leading -- double dash.
+! Set the has_arg field to true if it requires an argument, false if not.
+! The val field is returned. Typically this is set to the corresponding short
+! option, so short and long options can be processed together. (But there
+! is no requirement that every long option has a short option, or vice-versa.)
+!
+! -----
+! EXAMPLE
+! program test
+! use getopt_m
+! implicit none
+! character:: ch
+! type(option_s):: opts(2)
+! opts(1) = option_s( "alpha", .false., 'a' )
+! opts(2) = option_s( "beta", .true., 'b' )
+! do
+! select case( getopt( "ab:c", opts ))
+! case( char(0))
+! exit
+! case( 'a' )
+! print *, 'option alpha/a'
+! case( 'b' )
+! print *, 'option beta/b=', optarg
+! case( '?' )
+! print *, 'unknown option ', optopt
+! stop
+! case default
+! print *, 'unhandled option ', optopt, ' (this is a bug)'
+! end select
+! end do
+! end program test
+!
+! Differences from C version:
+! - when options are finished, C version returns -1 instead of char(0),
+! and thus stupidly requires an int instead of a char.
+! - does not support optreset
+! - does not support "--" as last argument
+! - if no argument, optarg is blank, not NULL
+! - argc and argv are implicit
+!
+! Differences for long options:
+! - optional argument to getopt(), rather than separate function getopt_long()
+! - has_arg is logical, and does not support optional_argument
+! - does not support flag field (and thus always returns val)
+! - does not support longindex
+! - does not support "--opt=value" syntax, only "--opt value"
+! - knows the length of longopts, so does not need an empty last record
+
+module getopt_m
+ implicit none
+ character(len=80):: optarg
+ character:: optopt
+ integer:: optind=1
+ logical:: opterr=.true.
+
+ type option_s
+ character(len=80) :: name
+ logical :: has_arg
+ character :: val
+ end type
+
+ ! grpind is index of next option within group; always >= 2
+ integer, private:: grpind=2
+
+contains
+
+! ----------------------------------------
+! Return str(i:j) if 1 <= i <= j <= len(str),
+! else return empty string.
+! This is needed because Fortran standard allows but doesn't *require* short-circuited
+! logical AND and OR operators. So this sometimes fails:
+! if ( i < len(str) .and. str(i+1:i+1) == ':' ) then
+! but this works:
+! if ( substr(str, i+1, i+1) == ':' ) then
+
+character function substr( str, i, j )
+ ! arguments
+ character(len=*), intent(in):: str
+ integer, intent(in):: i, j
+
+ if ( 1 <= i .and. i <= j .and. j <= len(str)) then
+ substr = str(i:j)
+ else
+ substr = ''
+ endif
+end function substr
+
+
+! ----------------------------------------
+character function getopt( optstring, longopts )
+ ! arguments
+ character(len=*), intent(in):: optstring
+ type(option_s), intent(in), optional:: longopts(:)
+
+ ! local variables
+ character(len=80):: arg
+
+ optarg = ''
+ if ( optind > iargc()) then
+ getopt = char(0)
+ endif
+
+ call getarg( optind, arg )
+ if ( present( longopts ) .and. arg(1:2) == '--' ) then
+ getopt = process_long( longopts, arg )
+ elseif ( arg(1:1) == '-' ) then
+ getopt = process_short( optstring, arg )
+ else
+ getopt = char(0)
+ endif
+end function getopt
+
+
+! ----------------------------------------
+character function process_long( longopts, arg )
+ ! arguments
+ type(option_s), intent(in):: longopts(:)
+ character(len=*), intent(in):: arg
+
+ ! local variables
+ integer:: i
+
+ ! search for matching long option
+ optind = optind + 1
+ do i = 1, size(longopts)
+ if ( arg(3:) == longopts(i)%name ) then
+ optopt = longopts(i)%val
+ process_long = optopt
+ if ( longopts(i)%has_arg ) then
+ if ( optind <= iargc()) then
+ call getarg( optind, optarg )
+ optind = optind + 1
+ elseif ( opterr ) then
+ WRITE (0,'(a,a,a)') "error: option '", trim(arg), "' requires an argument"
+ endif
+ endif
+ return
+ endif
+ end do
+ ! else not found
+ process_long = '?'
+ if ( opterr ) then
+ WRITE (0,'(a,a,a)'), "error: unrecognized option '", trim(arg), "'"
+ endif
+end function process_long
+
+
+! ----------------------------------------
+character function process_short( optstring, arg )
+ ! arguments
+ character(len=*), intent(in):: optstring, arg
+
+ ! local variables
+ integer:: i, arglen
+
+ arglen = len( trim( arg ))
+ optopt = arg(grpind:grpind)
+ process_short = optopt
+
+ i = index( optstring, optopt )
+ if ( i == 0 ) then
+ ! unrecognized option
+ process_short = '?'
+ if ( opterr ) then
+ print '(a,a,a)', "Error: unrecognized option '-", optopt, "'"
+ endif
+ endif
+ if ( i > 0 .and. substr( optstring, i+1, i+1 ) == ':' ) then
+ ! required argument
+ optind = optind + 1
+ if ( arglen > grpind ) then
+ ! -xarg, return remainder of arg
+ optarg = arg(grpind+1:arglen)
+ elseif ( optind <= iargc()) then
+ ! -x arg, return next arg
+ call getarg( optind, optarg )
+ optind = optind + 1
+ elseif ( opterr ) then
+ WRITE (0,'(a,a,a)') "error: option '-", optopt, "' requires an argument"
+ endif
+ grpind = 2
+ elseif ( arglen > grpind ) then
+ ! no argument (or unrecognized), go to next option in argument (-xyz)
+ grpind = grpind + 1
+ else
+ ! no argument (or unrecognized), go to next argument
+ grpind = 2
+ optind = optind + 1
+ endif
+end function process_short
+
+end module getopt_m
diff -r 617b7e74fbfb -r de8630bbadef include.f90
--- a/include.f90 Thu Oct 20 12:03:14 2011 -0700
+++ b/include.f90 Thu Oct 20 12:03:36 2011 -0700
@@ -1,11 +1,4 @@
-
-! implement the Intel Math Kernel Library
-#define IMKL_FFT
-
-! implement the Fastest Fourier Transform of the West, version 3
-!#define FFTW3 1
-! use multithreaded libraries
-!#define FFTW3_THREADS 1
+#include "config.h"
! implement SGI Fast Fourier Transforms library
!#define SGI_FFT 1
diff -r 617b7e74fbfb -r de8630bbadef input.f90
--- a/input.f90 Thu Oct 20 12:03:14 2011 -0700
+++ b/input.f90 Thu Oct 20 12:03:36 2011 -0700
@@ -17,7 +17,7 @@
! along with RELAX. If not, see <http://www.gnu.org/licenses/>.
!-----------------------------------------------------------------------
-#include 'include.f90'
+#include "include.f90"
MODULE input
@@ -227,7 +227,7 @@ CONTAINS
PRINT '(2ES9.2E1,I3.2,ES9.2E1)',in%lon0,in%lat0,in%zone,in%umult
IF (in%zone.GT.60 .OR. in%zone.LT.1) THEN
WRITE_DEBUG_INFO
- WRITE (0,'("invalid UTM zone ",I," (1<=zone<=60. exiting.)")') in%zone
+ WRITE (0,'("invalid UTM zone ",I3," (1<=zone<=60. exiting.)")') in%zone
STOP 1
END IF
END IF
diff -r 617b7e74fbfb -r de8630bbadef types.f90
--- a/types.f90 Thu Oct 20 12:03:14 2011 -0700
+++ b/types.f90 Thu Oct 20 12:03:36 2011 -0700
@@ -17,7 +17,7 @@
! along with RELAX. If not, see <http://www.gnu.org/licenses/>.
!-----------------------------------------------------------------------
-#include 'include.f90'
+#include "include.f90"
MODULE types
More information about the CIG-COMMITS
mailing list