[cig-commits] r8499 - in seismo/2D/SPECFEM2D/trunk: . DATA
walter at geodynamics.org
walter at geodynamics.org
Fri Dec 7 15:51:09 PST 2007
Author: walter
Date: 2007-12-07 15:51:08 -0800 (Fri, 07 Dec 2007)
New Revision: 8499
Modified:
seismo/2D/SPECFEM2D/trunk/DATA/Par_file
seismo/2D/SPECFEM2D/trunk/Makefile
seismo/2D/SPECFEM2D/trunk/create_color_image.f90
seismo/2D/SPECFEM2D/trunk/meshfem2D.f90
seismo/2D/SPECFEM2D/trunk/read_value_parameters.f90
Log:
fixed problem of mesher crashing when Par_file contains CR-LF (for instance files edited under Windows).
fixed problem of binary PNM images not correctly created when number of points NX > 999 or NY > 999.
fixed confusion between FLAGS_CHECK and FLAGS_NOCHECK in the Makefile.
Modified: seismo/2D/SPECFEM2D/trunk/DATA/Par_file
===================================================================
--- seismo/2D/SPECFEM2D/trunk/DATA/Par_file 2006-12-11 19:11:48 UTC (rev 8498)
+++ seismo/2D/SPECFEM2D/trunk/DATA/Par_file 2007-12-07 23:51:08 UTC (rev 8499)
@@ -52,7 +52,7 @@
# display parameters
itaff = 100 # display frequency in time steps
-output_postscript_snapshot = .true. # output Postscript image of the results
+output_postscript_snapshot = .false. # output Postscript image of the results
output_color_image = .true. # output color image of the results
vecttype = 1 # display 1=displ 2=veloc 3=accel
cutvect = 1. # amplitude min en % pour vector plots
Modified: seismo/2D/SPECFEM2D/trunk/Makefile
===================================================================
--- seismo/2D/SPECFEM2D/trunk/Makefile 2006-12-11 19:11:48 UTC (rev 8498)
+++ seismo/2D/SPECFEM2D/trunk/Makefile 2007-12-07 23:51:08 UTC (rev 8499)
@@ -9,19 +9,19 @@
# Portland Linux
#F90 = pgf90
+#FLAGS_NOCHECK=-fast -Mnobounds -Minline -Mneginfo -Mdclchk
#FLAGS_CHECK=-O0 -Mbounds -Mneginfo -Mdclchk
-#FLAGS_NOCHECK=-fast -Mnobounds -Minline -Mneginfo -Mdclchk
# Intel Linux
-#F90 = ifort
-#FLAGS_CHECK=-O0 -implicitnone -warn stderrors -warn truncated_source -warn argument_checking -warn unused -warn declarations -std95 -assume byterecl -check bounds
-#FLAGS_NOCHECK=-O3 -implicitnone -warn stderrors -warn truncated_source -warn argument_checking -warn unused -warn declarations -std95 -assume byterecl -check nobounds
-#FLAGS_NOCHECK = $(FLAGS_CHECK)
+F90 = ifort
+#FLAGS_NOCHECK=-O0 -implicitnone -warn stderrors -warn truncated_source -warn argument_checking -warn unused -warn declarations -std95 -assume byterecl -check bounds
+FLAGS_NOCHECK=-O3 -implicitnone -warn stderrors -warn truncated_source -warn argument_checking -warn unused -warn declarations -std95 -assume byterecl -check nobounds
+FLAGS_CHECK = $(FLAGS_NOCHECK) -check bounds
# GNU gfortran
-F90 = gfortran
-FLAGS_NOCHECK = -std=gnu -fimplicit-none -frange-check -O2 -Wunused-labels -Waliasing -Wampersand -Wsurprising -Wline-truncation -Wunderflow
-FLAGS_CHECK = $(FLAGS_NOCHECK) -fbounds-check
+#F90 = gfortran
+#FLAGS_NOCHECK = -std=gnu -fimplicit-none -frange-check -O2 -Wunused-labels -Waliasing -Wampersand -Wsurprising -Wline-truncation -Wunderflow
+#FLAGS_CHECK = $(FLAGS_NOCHECK) -fbounds-check
LINK = $(F90)
Modified: seismo/2D/SPECFEM2D/trunk/create_color_image.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/create_color_image.f90 2006-12-11 19:11:48 UTC (rev 8498)
+++ seismo/2D/SPECFEM2D/trunk/create_color_image.f90 2007-12-07 23:51:08 UTC (rev 8499)
@@ -29,7 +29,7 @@
double precision, dimension(NX,NY) :: donnees_image_color_2D
- integer ix,iy,R,G,B,centaines,dizaines,unites,current_rec
+ integer ix,iy,R,G,B,dixmilliers,milliers,centaines,dizaines,unites,reste,current_rec
double precision amplitude_max,valeur_normalisee
@@ -52,33 +52,92 @@
write(27,rec=2) '6' ! ecrire P6 = format d'image PNM binaire
write(27,rec=3) char(ascii_code_of_carriage_return)
-! ecrire la taille
- centaines = NX / 100
- dizaines = (NX - 100 * centaines) / 10
- unites = NX - 100 * centaines - 10 * dizaines
+! compute and write horizontal size
+ reste = NX
- write(27,rec=4) char(centaines + ascii_code_of_zero)
- write(27,rec=5) char(dizaines + ascii_code_of_zero)
- write(27,rec=6) char(unites + ascii_code_of_zero)
- write(27,rec=7) ' '
+ dixmilliers = reste / 10000
+ reste = reste - 10000 * dixmilliers
- centaines = NY / 100
- dizaines = (NY - 100 * centaines) / 10
- unites = NY - 100 * centaines - 10 * dizaines
+ milliers = reste / 1000
+ reste = reste - 1000 * milliers
- write(27,rec=8) char(centaines + ascii_code_of_zero)
- write(27,rec=9) char(dizaines + ascii_code_of_zero)
- write(27,rec=10) char(unites + ascii_code_of_zero)
- write(27,rec=11) char(ascii_code_of_carriage_return)
+ centaines = reste / 100
+ reste = reste - 100 * centaines
-! nombre de nuances
- write(27,rec=12) '2'
- write(27,rec=13) '5'
- write(27,rec=14) '5'
+ dizaines = reste / 10
+ reste = reste - 10 * dizaines
+
+ unites = reste
+
+ if(dixmilliers > 0) then
+ write(27,rec=4) char(dixmilliers + ascii_code_of_zero)
+ else
+ write(27,rec=4) ' '
+ endif
+
+ if(milliers > 0) then
+ write(27,rec=5) char(milliers + ascii_code_of_zero)
+ else
+ write(27,rec=5) ' '
+ endif
+
+ if(centaines > 0) then
+ write(27,rec=6) char(centaines + ascii_code_of_zero)
+ else
+ write(27,rec=6) ' '
+ endif
+
+ write(27,rec=7) char(dizaines + ascii_code_of_zero)
+ write(27,rec=8) char(unites + ascii_code_of_zero)
+ write(27,rec=9) ' '
+
+! compute and write vertical size
+ reste = NY
+
+ dixmilliers = reste / 10000
+ reste = reste - 10000 * dixmilliers
+
+ milliers = reste / 1000
+ reste = reste - 1000 * milliers
+
+ centaines = reste / 100
+ reste = reste - 100 * centaines
+
+ dizaines = reste / 10
+ reste = reste - 10 * dizaines
+
+ unites = reste
+
+ if(dixmilliers > 0) then
+ write(27,rec=10) char(dixmilliers + ascii_code_of_zero)
+ else
+ write(27,rec=10) ' '
+ endif
+
+ if(milliers > 0) then
+ write(27,rec=11) char(milliers + ascii_code_of_zero)
+ else
+ write(27,rec=11) ' '
+ endif
+
+ if(centaines > 0) then
+ write(27,rec=12) char(centaines + ascii_code_of_zero)
+ else
+ write(27,rec=12) ' '
+ endif
+
+ write(27,rec=13) char(dizaines + ascii_code_of_zero)
+ write(27,rec=14) char(unites + ascii_code_of_zero)
write(27,rec=15) char(ascii_code_of_carriage_return)
+! nombre de nuances
+ write(27,rec=16) '2'
+ write(27,rec=17) '5'
+ write(27,rec=18) '5'
+ write(27,rec=19) char(ascii_code_of_carriage_return)
+
! block of image data starts at sixteenth character
- current_rec = 16
+ current_rec = 20
else
Modified: seismo/2D/SPECFEM2D/trunk/meshfem2D.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/meshfem2D.f90 2006-12-11 19:11:48 UTC (rev 8498)
+++ seismo/2D/SPECFEM2D/trunk/meshfem2D.f90 2007-12-07 23:51:08 UTC (rev 8499)
@@ -135,7 +135,7 @@
! loop on all the points describing this interface
do ipoint_current = 1,npoints_interface_bottom
- read(IIN_INTERFACES,*) xinterface_dummy,zinterface_dummy
+ call read_two_interface_points(IIN_INTERFACES,DONT_IGNORE_JUNK,xinterface_dummy,zinterface_dummy)
if(ipoint_current > 1 .and. xinterface_dummy <= xinterface_dummy_previous) &
stop 'interface points must be sorted in increasing X'
xinterface_dummy_previous = xinterface_dummy
@@ -293,7 +293,7 @@
num_modele(:,:) = 0
do imodele=1,nbmodeles
- read(IIN,*) i,icodematread,rhoread,cpread,csread,aniso3read,aniso4read
+ call read_material_parameters(IIN,DONT_IGNORE_JUNK,i,icodematread,rhoread,cpread,csread,aniso3read,aniso4read)
if(i < 1 .or. i > nbmodeles) stop 'Wrong model number!!'
icodemat(i) = icodematread
rho(i) = rhoread
@@ -334,7 +334,7 @@
do izone = 1,nbzone
- read(IIN,*) ixdebzone,ixfinzone,izdebzone,izfinzone,imodnum
+ call read_zone_coordinates(IIN,DONT_IGNORE_JUNK,ixdebzone,ixfinzone,izdebzone,izfinzone,imodnum)
if(imodnum < 1) stop 'Negative model number not allowed !!'
if(ixdebzone < 1) stop 'Left coordinate of zone negative !!'
@@ -446,7 +446,8 @@
! loop on all the points describing this interface
do ipoint_current = 1,npoints_interface_bottom
- read(IIN_INTERFACES,*) xinterface_bottom(ipoint_current),zinterface_bottom(ipoint_current)
+ call read_two_interface_points(IIN_INTERFACES,DONT_IGNORE_JUNK, &
+ xinterface_bottom(ipoint_current),zinterface_bottom(ipoint_current))
enddo
! boucle sur toutes les couches
@@ -457,7 +458,8 @@
! loop on all the points describing this interface
do ipoint_current = 1,npoints_interface_top
- read(IIN_INTERFACES,*) xinterface_top(ipoint_current),zinterface_top(ipoint_current)
+ call read_two_interface_points(IIN_INTERFACES,DONT_IGNORE_JUNK, &
+ xinterface_top(ipoint_current),zinterface_top(ipoint_current))
enddo
! calculer le spline pour l'interface du bas, imposer la tangente aux deux bords
Modified: seismo/2D/SPECFEM2D/trunk/read_value_parameters.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/read_value_parameters.f90 2006-12-11 19:11:48 UTC (rev 8498)
+++ seismo/2D/SPECFEM2D/trunk/read_value_parameters.f90 2007-12-07 23:51:08 UTC (rev 8499)
@@ -77,6 +77,55 @@
!--------------------
+ subroutine read_two_interface_points(iin,ignore_junk,value_to_read_1,value_to_read_2)
+
+ implicit none
+
+ integer iin
+ logical ignore_junk
+ double precision value_to_read_1,value_to_read_2
+ character(len=100) string_read
+
+ call read_next_line(iin,ignore_junk,string_read)
+ read(string_read,*) value_to_read_1,value_to_read_2
+
+ end subroutine read_two_interface_points
+
+!--------------------
+
+ subroutine read_zone_coordinates(iin,ignore_junk,value_to_read_1,value_to_read_2,value_to_read_3,value_to_read_4,value_to_read_5)
+
+ implicit none
+
+ integer iin
+ logical ignore_junk
+ integer value_to_read_1,value_to_read_2,value_to_read_3,value_to_read_4,value_to_read_5
+ character(len=100) string_read
+
+ call read_next_line(iin,ignore_junk,string_read)
+ read(string_read,*) value_to_read_1,value_to_read_2,value_to_read_3,value_to_read_4,value_to_read_5
+
+ end subroutine read_zone_coordinates
+
+!--------------------
+
+ subroutine read_material_parameters(iin,ignore_junk,i,icodematread,rhoread,cpread,csread,aniso3read,aniso4read)
+
+ implicit none
+
+ integer iin
+ logical ignore_junk
+ integer i,icodematread
+ double precision rhoread,cpread,csread,aniso3read,aniso4read
+ character(len=100) string_read
+
+ call read_next_line(iin,ignore_junk,string_read)
+ read(string_read,*) i,icodematread,rhoread,cpread,csread,aniso3read,aniso4read
+
+ end subroutine read_material_parameters
+
+!--------------------
+
subroutine read_next_line(iin,ignore_junk,string_read)
implicit none
@@ -93,6 +142,9 @@
! suppress leading white spaces, if any
string_read = adjustl(string_read)
+! suppress trailing carriage return (ASCII code 13) if any (e.g. if input text file coming from Windows/DOS)
+ if(index(string_read,achar(13)) > 0) string_read = string_read(1:index(string_read,achar(13))-1)
+
! exit loop when we find the first line that is not a comment or a white line
if(len_trim(string_read) == 0) cycle
if(string_read(1:1) /= '#') exit
More information about the cig-commits
mailing list