[cig-commits] r8501 - seismo/2D/SPECFEM2D/trunk
walter at geodynamics.org
walter at geodynamics.org
Fri Dec 7 15:51:18 PST 2007
Author: walter
Date: 2007-12-07 15:51:17 -0800 (Fri, 07 Dec 2007)
New Revision: 8501
Modified:
seismo/2D/SPECFEM2D/trunk/circ.f90
seismo/2D/SPECFEM2D/trunk/meshfem2D.f90
seismo/2D/SPECFEM2D/trunk/plotpost.f90
seismo/2D/SPECFEM2D/trunk/specfem2D.f90
Log:
changed output of time step information, and changed path to "Database" file; also added a few comments about the fact that the acoustic free surface is not compatible with an absorbing condition there
Modified: seismo/2D/SPECFEM2D/trunk/circ.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/circ.f90 2006-12-18 22:17:59 UTC (rev 8500)
+++ seismo/2D/SPECFEM2D/trunk/circ.f90 2007-12-07 23:51:17 UTC (rev 8501)
@@ -632,7 +632,7 @@
write(*,*)
write(*,*) 'Generation de la base de donnees...'
- open(unit=15,file='../SPECFEM90/DataBase',status='unknown')
+ open(unit=15,file='OUTPUT_FILES/Database',status='unknown')
title = 'Modele Canyon Paco'
write(15,*) '#'
Modified: seismo/2D/SPECFEM2D/trunk/meshfem2D.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/meshfem2D.f90 2006-12-18 22:17:59 UTC (rev 8500)
+++ seismo/2D/SPECFEM2D/trunk/meshfem2D.f90 2007-12-07 23:51:17 UTC (rev 8501)
@@ -751,6 +751,7 @@
! generer la liste des elements a la surface libre
if(nelemsurface > 0) then
write(15,*) 'Liste des elements a la surface libre'
+! we need to know if it is also an absorbing edge, in which case we turn off the acoustic free surface
write(15,*) abshaut
inumsurface = 0
do iz = 1,nzread
Modified: seismo/2D/SPECFEM2D/trunk/plotpost.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/plotpost.f90 2006-12-18 22:17:59 UTC (rev 8500)
+++ seismo/2D/SPECFEM2D/trunk/plotpost.f90 2007-12-07 23:51:17 UTC (rev 8501)
@@ -1268,16 +1268,14 @@
green(236) = 0.894117647058824
blue(236) = 0.768627450980392
-! recherche des positions maximales des points de la grille
- xmax=maxval(coord(1,:))
- zmax=maxval(coord(2,:))
- write(IOUT,*) 'Max X = ',xmax
- write(IOUT,*) 'Max Z = ',zmax
+! get minimum and maximum values of mesh coordinates
+ xmin = minval(coord(1,:))
+ zmin = minval(coord(2,:))
+ xmax = maxval(coord(1,:))
+ zmax = maxval(coord(2,:))
+ write(IOUT,*) 'X min, max = ',xmin,xmax
+ write(IOUT,*) 'Z min, max = ',zmin,zmax
-! limite du repere physique
- xmin=0.d0
- zmin=0.d0
-
! rapport taille page/taille domaine physique
rapp_page = min(rpercentz*sizez/(zmax-zmin),rpercentx*sizex/(xmax-xmin)) / 100.d0
@@ -1387,7 +1385,7 @@
write(24,*) '24. CM 1.95 CM MV'
timeval = it*dt
- if(timeval >= 1.d-3) then
+ if(timeval >= 1.d-3 .and. timeval < 1000.d0) then
write(24,600) usoffset,timeval
else
write(24,601) usoffset,timeval
@@ -1997,14 +1995,13 @@
close(24)
10 format('%!PS-Adobe-2.0',/,'%%',/,'%% Title: ',a50,/, &
- '%% Created by: Specfem2D',/, &
- '%% Author: Dimitri Komatitsch',/,'%%')
+ '%% Created by: Specfem2D',/,'%% Author: Dimitri Komatitsch',/,'%%')
510 format(f5.1,1x,f5.1,' M')
- 600 format(f6.3,' neg CM 0 MR (Time =',f6.3,' s) show')
- 601 format(f6.3,' neg CM 0 MR (Time =',1pe10.3,' s) show')
+ 600 format(f6.3,' neg CM 0 MR (Time =',f8.3,' s) show')
+ 601 format(f6.3,' neg CM 0 MR (Time =',1pe12.3,' s) show')
610 format(f6.3,' neg CM 0 MR (Time step = ',i7,') show')
620 format(f6.3,' neg CM 0 MR (Cut =',f5.2,' \%) show')
- 640 format(f6.3,' neg CM 0 MR (Max norm =',1pe10.3,') show')
+ 640 format(f6.3,' neg CM 0 MR (Max norm =',1pe12.3,') show')
499 format(f5.1,1x,f5.1,' L')
500 format(f5.1,1x,f5.1,' M')
Modified: seismo/2D/SPECFEM2D/trunk/specfem2D.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/specfem2D.f90 2006-12-18 22:17:59 UTC (rev 8500)
+++ seismo/2D/SPECFEM2D/trunk/specfem2D.f90 2007-12-07 23:51:17 UTC (rev 8501)
@@ -393,8 +393,12 @@
allocate(codeabs(4,nelemabs))
! --- allocate array for free surface condition in acoustic medium
- if(nelemsurface <= 0) nelemsurface = 1
- allocate(numsurface(nelemsurface))
+ if(nelemsurface <= 0) then
+ nelemsurface = 0
+ allocate(numsurface(1))
+ else
+ allocate(numsurface(nelemsurface))
+ endif
!
!---- print element group main parameters
@@ -440,15 +444,22 @@
!
!---- read free surface data
!
- read(IIN,"(a80)") datlin
- read(IIN,*) abshaut
- do n=1,nelemsurface
- read(IIN,*) inum,numsurfaceread
- if(inum < 1 .or. inum > nelemsurface) stop 'Wrong free surface element number'
- numsurface(inum) = numsurfaceread
- enddo
- write(IOUT,*)
- write(IOUT,*) 'Number of free surface elements: ',nelemsurface
+ if(nelemsurface > 0) then
+ read(IIN,"(a80)") datlin
+! we need to know if it is also an absorbing edge, in which case we turn off the acoustic free surface
+ read(IIN,*) abshaut
+ do n=1,nelemsurface
+ read(IIN,*) inum,numsurfaceread
+ if(inum < 1 .or. inum > nelemsurface) stop 'Wrong free surface element number'
+ numsurface(inum) = numsurfaceread
+ enddo
+ write(IOUT,*)
+ write(IOUT,*) 'Number of free surface elements: ',nelemsurface
+ if(ACOUSTIC .and. abshaut) then
+ write(IOUT,*)
+ write(IOUT,*) 'top acoustic surface cannot be both absorbing and free, turning off the free surface'
+ endif
+ endif
!
!---- close input file
@@ -1577,14 +1588,14 @@
endif ! end of test on attenuation
-!---- display time step max of norm of displacement
+!---- display time step and max of norm of displacement
if(mod(it,IT_AFFICHE) == 0 .or. it == 5) then
write(IOUT,*)
- if(time >= 1.d-3) then
- write(IOUT,"('Pas de temps numero ',i6,' t = ',f7.4,' s')") it,time
+ if(time >= 1.d-3 .and. time < 1000.d0) then
+ write(IOUT,"('Time step number ',i6,' t = ',f9.4,' s')") it,time
else
- write(IOUT,"('Pas de temps numero ',i6,' t = ',1pe10.4,' s')") it,time
+ write(IOUT,"('Time step number ',i6,' t = ',1pe12.6,' s')") it,time
endif
displnorm_all = maxval(sqrt(displ(1,:)**2 + displ(2,:)**2))
More information about the cig-commits
mailing list