[cig-commits] r8413 - in seismo/2D/SPECFEM2D/trunk: MAILLE90
SPECFEM90
walter at geodynamics.org
walter at geodynamics.org
Fri Dec 7 15:44:10 PST 2007
Author: walter
Date: 2007-12-07 15:44:09 -0800 (Fri, 07 Dec 2007)
New Revision: 8413
Modified:
seismo/2D/SPECFEM2D/trunk/MAILLE90/circ.f90
seismo/2D/SPECFEM2D/trunk/MAILLE90/maille.f90
seismo/2D/SPECFEM2D/trunk/MAILLE90/maille_non_struct_2.f90
seismo/2D/SPECFEM2D/trunk/MAILLE90/maille_non_struct_3.f90
seismo/2D/SPECFEM2D/trunk/MAILLE90/maille_struct.f90
seismo/2D/SPECFEM2D/trunk/SPECFEM90/Makefile
seismo/2D/SPECFEM2D/trunk/SPECFEM90/createnum_fast.f90
seismo/2D/SPECFEM2D/trunk/SPECFEM90/createnum_slow.f90
seismo/2D/SPECFEM2D/trunk/SPECFEM90/defarrays.f90
seismo/2D/SPECFEM2D/trunk/SPECFEM90/getelspec.f90
seismo/2D/SPECFEM2D/trunk/SPECFEM90/plotpost.f90
seismo/2D/SPECFEM2D/trunk/SPECFEM90/q49spec.f90
seismo/2D/SPECFEM2D/trunk/SPECFEM90/qinpspec.f90
seismo/2D/SPECFEM2D/trunk/SPECFEM90/qsumspec.f90
seismo/2D/SPECFEM2D/trunk/SPECFEM90/specfem.f90
Log:
cleaned source codes to ensure f95 compatibility, and declared all variables
(compiled on Dec Alpha to make sure new source codes are clean and give no warnings)
Modified: seismo/2D/SPECFEM2D/trunk/MAILLE90/circ.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/MAILLE90/circ.f90 2007-12-07 23:44:01 UTC (rev 8412)
+++ seismo/2D/SPECFEM2D/trunk/MAILLE90/circ.f90 2007-12-07 23:44:09 UTC (rev 8413)
@@ -21,53 +21,64 @@
program circ
- implicit double precision (a-h,o-z)
+ implicit none
! max size of the model in elements
- parameter(mnx=7)
- parameter(mnz=7)
+ integer, parameter :: mnx=7,mnz=7
- parameter(pi=3.141592653589793d0)
+ double precision, parameter :: pi=3.141592653589793d0
! seuil pour considerer deux points comme confondus
- parameter(rseuil=1.d-2)
+ double precision, parameter :: rseuil=1.d-2
+! declare variables
+ integer imaxabs,n2ana,itimetype,isource_type,nump1,nump2,nump3,nump4
+ integer ndofn,ndime,ngnod,nnode,nbcnd,n1ana
+ integer nofst,npgeo,nspel,nbmodeles,nbsources,nrec,lquad,isamp,nrec1,nrec2
+ integer irec,imatnum,netyp,nxgll,nelemperio,nelemabs,nx,nz,i,j
+ integer irepr,nrecsur3,nt,niter,itaff,itfirstaff,numerocourant,iptsdisp,isubsamp
+
+ double precision R,theta_i,theta_init,delta_theta,eta_j,valseuil,freqmaxrep
+ double precision f0,t0,xs,zs,angle,factor,dist,xoffs,zoffs
+ double precision xrec,zrec,rho,cp,cs,anglerec
+ double precision anglerec2,dt,alphanewm,betanewm,gammanewm
+ double precision cutvect,cutcolor,scalex,scalez,sizemax,orig_x,orig_z
+ double precision factorana,factorxsu
+
! stockage de la grille curvi (x et z)
- parameter(npoinz1=(4*mnx+1)*(mnz+1))
- parameter(nelemz1=(4*mnx)*mnz)
+ integer, parameter :: npoinz1=(4*mnx+1)*(mnz+1), nelemz1=(4*mnx)*mnz
double precision x1(0:4*mnx,0:mnz)
double precision z1(0:4*mnx,0:mnz)
- parameter(npoinz3=(2*mnx+1)*(4*mnz+1))
- parameter(nelemz3=(2*mnx)*(4*mnz))
+
+ integer, parameter :: npoinz3=(2*mnx+1)*(4*mnz+1), nelemz3=(2*mnx)*(4*mnz)
double precision x3(0:2*mnx,0:4*mnz)
double precision z3(0:2*mnx,0:4*mnz)
- parameter(npoinz4=(2*mnx+1)*(2*mnz+1))
- parameter(nelemz4=(2*mnx)*(2*mnz))
+
+ integer, parameter :: npoinz4=(2*mnx+1)*(2*mnz+1), nelemz4=(2*mnx)*(2*mnz)
double precision x4(0:2*mnx,0:2*mnz)
double precision z4(0:2*mnx,0:2*mnz)
- parameter(npoinz1b=(2*mnx+1)*(mnz+1))
- parameter(nelemz1b=(2*mnx)*mnz)
+ integer, parameter :: npoinz1b=(2*mnx+1)*(mnz+1), nelemz1b=(2*mnx)*mnz
double precision x1b(0:2*mnx,0:mnz)
double precision z1b(0:2*mnx,0:mnz)
- parameter(npoinz2b=(mnx+1)*(2*mnz+1))
- parameter(nelemz2b=mnx*(2*mnz))
+
+ integer, parameter :: npoinz2b=(mnx+1)*(2*mnz+1), nelemz2b=mnx*(2*mnz)
double precision x2b(0:mnx,0:2*mnz)
double precision z2b(0:mnx,0:2*mnz)
- parameter(npoinz3b=(4*mnx+1)*(4*mnz+1))
- parameter(nelemz3b=(4*mnx)*(4*mnz))
+
+ integer, parameter :: npoinz3b=(4*mnx+1)*(4*mnz+1), nelemz3b=(4*mnx)*(4*mnz)
double precision x3b(0:4*mnx,0:4*mnz)
double precision z3b(0:4*mnx,0:4*mnz)
- parameter(npoinz4b=(2*mnx+1)*(2*mnz+1))
- parameter(nelemz4b=(2*mnx)*(2*mnz))
+
+ integer, parameter :: npoinz4b=(2*mnx+1)*(2*mnz+1), nelemz4b=(2*mnx)*(2*mnz)
double precision x4b(0:2*mnx,0:2*mnz)
double precision z4b(0:2*mnx,0:2*mnz)
! nombre max de points de maillage, et nombre exact d'elements
- parameter(npoin = npoinz1+npoinz3+npoinz4+ &
- npoinz1b+npoinz2b+npoinz3b+npoinz4b)
- parameter(nelem = nelemz1+nelemz3+nelemz4+ &
- nelemz1b+nelemz2b+nelemz3b+nelemz4b)
+ integer, parameter :: npoin = npoinz1+npoinz3+npoinz4+ &
+ npoinz1b+npoinz2b+npoinz3b+npoinz4b
+ integer, parameter :: nelem = nelemz1+nelemz3+nelemz4+ &
+ nelemz1b+nelemz2b+nelemz3b+nelemz4b
! coordonnees geometriques des points
double precision xpoint(npoin)
@@ -90,9 +101,7 @@
integer numpoin4(nelem)
! nom du fichier GNUPLOT contenant la grille
- character file1*50
- character title*50
- character external_mod*50
+ character(len=50) file1,title
logical iexternal, aleatoire, topoplane, simulate, absstacey
logical absorbhaut, absorbbas, absorbgauche, sismos
Modified: seismo/2D/SPECFEM2D/trunk/MAILLE90/maille.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/MAILLE90/maille.f90 2007-12-07 23:44:01 UTC (rev 8412)
+++ seismo/2D/SPECFEM2D/trunk/MAILLE90/maille.f90 2007-12-07 23:44:09 UTC (rev 8413)
@@ -72,7 +72,7 @@
logical abshaut,absbas,absgauche,absdroite
logical periohaut,periogauche
logical sismos,isources_surf,ienreg_surf,display
- logical ivectplot,imeshvect,isymbols
+ logical ivectplot,imeshvect
logical iexec,initialfield
logical imodelvect,iboundvect,usletter,compenergy
@@ -994,13 +994,6 @@
! --- bas du modele
!
- double precision function botprime(x)
- implicit none
- double precision x
- botprime = 0.d0
- return
- end function botprime
-
double precision function bottom(x)
implicit none
double precision x
@@ -1029,24 +1022,6 @@
return
end function spl
-!--- derivee spline
- double precision function spl_prime(x,xtopo,ztopo,coefs,ntopo)
- implicit none
- integer ntopo
- double precision x
- double precision xtopo(ntopo),ztopo(ntopo)
- double precision coefs(ntopo)
-
- if (x < xtopo(1).or.x > xtopo(ntopo)) then
- spl_prime = 0.d0
- else
- call splintderiv(xtopo,ztopo,coefs,ntopo,x,spl_prime)
- endif
-
- return
- end function spl_prime
-
-
! --- fonction de densification du maillage horizontal
double precision function dens(ix,psi,xmin,xmax,nx)
@@ -1066,15 +1041,16 @@
subroutine spline(x,y,n,yp1,ypn,y2)
implicit none
- integer, parameter :: nmax=20000
integer n
- double precision x(n),y(n),y2(n),u(nmax)
+ double precision x(n),y(n),y2(n)
+ double precision, dimension(:), allocatable :: u
double precision yp1,ypn
integer i,k
double precision sig,p,qn,un
- if(n > nmax) stop 'array too small in spline'
+ allocate(u(n))
+
y2(1)=-0.5
u(1)=(3./(x(2)-x(1)))*((y(2)-y(1))/(x(2)-x(1))-yp1)
do i=2,n-1
@@ -1090,6 +1066,9 @@
do k=n-1,1,-1
y2(k)=y2(k)*y2(k+1)+u(k)
enddo
+
+ deallocate(u)
+
return
end subroutine spline
@@ -1108,15 +1087,14 @@
KLO=1
KHI=N
- 1 IF (KHI-KLO > 1) THEN
+ do while (KHI-KLO > 1)
K=(KHI+KLO)/2
IF(XA(K) > X)THEN
KHI=K
ELSE
KLO=K
ENDIF
- GOTO 1
- ENDIF
+ enddo
H=XA(KHI)-XA(KLO)
IF (H == 0.d0) stop 'Bad input in spline evaluation'
A=(XA(KHI)-X)/H
@@ -1127,36 +1105,3 @@
RETURN
end subroutine SPLINT
-! --------------
-
-! evaluation de la derivee premiere du spline (inspire de Numerical Recipes)
- SUBROUTINE SPLINTDERIV(XA,YA,Y2A,N,X,Y)
- implicit none
-
- integer n
- double precision XA(N),YA(N),Y2A(N)
- double precision x,y
-
- integer k,klo,khi
- double precision h,a,b
-
- KLO=1
- KHI=N
- 1 IF (KHI-KLO > 1) THEN
- K=(KHI+KLO)/2
- IF(XA(K) > X)THEN
- KHI=K
- ELSE
- KLO=K
- ENDIF
- GOTO 1
- ENDIF
- H=XA(KHI)-XA(KLO)
- IF (H == 0.d0) stop 'Bad input in spline derivative evaluation'
- A=(XA(KHI)-X)/H
- B=(X-XA(KLO))/H
-
- Y=(-YA(KLO)+YA(KHI))/h+((-3.0d0*A**2+1.0d0)*Y2A(KLO)+ &
- (3.0d0*B**2-1.0d0)*Y2A(KHI))*H/6.d0
- RETURN
- end subroutine SPLINTDERIV
Modified: seismo/2D/SPECFEM2D/trunk/MAILLE90/maille_non_struct_2.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/MAILLE90/maille_non_struct_2.f90 2007-12-07 23:44:01 UTC (rev 8412)
+++ seismo/2D/SPECFEM2D/trunk/MAILLE90/maille_non_struct_2.f90 2007-12-07 23:44:09 UTC (rev 8413)
@@ -44,26 +44,21 @@
! arrays for the receivers
double precision, allocatable :: xrec(:),zrec(:)
-! nom du fichier GNUPLOT contenant la grille
- character(len=50) file1
-
character(len=50) interffile,topofile,title
character(len=15) junk
integer imatnum,inumabs,inumelem,nelemperio,nxgll,netyp
integer icodehaut,icodebas,icodegauche,icodedroite
integer nelemabs,npgeo,nspec,ntopo,nspecvolume,nspecWz
- integer k,icol,ili,istepx,istepz,ncut,ix,iz,irec,i,j,iadd
- integer ixdebzone,ixfinzone,izdebzone,izfinzone,imodnum
- integer izone,imodele,nbzone,nbmodeles,iaffinfo
+ integer k,ix,iz,irec,i,j,iadd
+ integer imodele,nbmodeles,iaffinfo
integer itaff,itfirstaff,iptsdisp,isubsamp,nrec,n1ana,n2ana
integer irepr,nrec1,nrec2,isamp,nbsources,isismostype,ivecttype
integer ngnod,nt,niter,idegpoly,nx,nz
- integer inumelem2,ix2,iz2,inumperio
integer icodematread
double precision valseuil,freqmaxrep,ratio
- double precision tang1,tangN,vpzone,vszone
+ double precision tang1,tangN
double precision orig_x,orig_z,sizemax,cutvect,scalex,scalez
double precision factorxsu,factorana,xspacerec,zspacerec
double precision anglerec,anglerec2,xmin,xmax
@@ -75,7 +70,7 @@
logical abshaut,absbas,absgauche,absdroite,absstacey
logical periohaut,periogauche
logical sismos,isources_surf,ienreg_surf,ienreg_surf2,display
- logical ivectplot,imeshvect,isymbols
+ logical ivectplot,imeshvect
logical topoplane,iexec,initialfield
logical imodelvect,iboundvect,usletter,compenergy
Modified: seismo/2D/SPECFEM2D/trunk/MAILLE90/maille_non_struct_3.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/MAILLE90/maille_non_struct_3.f90 2007-12-07 23:44:01 UTC (rev 8412)
+++ seismo/2D/SPECFEM2D/trunk/MAILLE90/maille_non_struct_3.f90 2007-12-07 23:44:09 UTC (rev 8413)
@@ -44,26 +44,21 @@
! arrays for the receivers
double precision, allocatable :: xrec(:),zrec(:)
-! nom du fichier GNUPLOT contenant la grille
- character(len=50) file1
-
character(len=50) interffile,topofile,title
character(len=15) junk
integer imatnum,inumabs,inumelem,nelemperio,nxgll,netyp
integer icodehaut,icodebas,icodegauche,icodedroite
integer nelemabs,npgeo,nspec,ntopo,nspecvolume,nspecWz
- integer k,icol,ili,istepx,istepz,ncut,ix,iz,irec,i,j,iadd
- integer ixdebzone,ixfinzone,izdebzone,izfinzone,imodnum
- integer izone,imodele,nbzone,nbmodeles,iaffinfo
+ integer k,ix,iz,irec,i,j,iadd
+ integer imodele,nbmodeles,iaffinfo
integer itaff,itfirstaff,iptsdisp,isubsamp,nrec,n1ana,n2ana
integer irepr,nrec1,nrec2,isamp,nbsources,isismostype,ivecttype
integer ngnod,nt,niter,idegpoly,nx,nz
- integer inumelem2,ix2,iz2,inumperio
integer icodematread
double precision valseuil,freqmaxrep,ratio
- double precision tang1,tangN,vpzone,vszone
+ double precision tang1,tangN
double precision orig_x,orig_z,sizemax,cutvect,scalex,scalez
double precision factorxsu,factorana,xspacerec,zspacerec
double precision anglerec,anglerec2,xmin,xmax
@@ -75,7 +70,7 @@
logical abshaut,absbas,absgauche,absdroite,absstacey
logical periohaut,periogauche
logical sismos,isources_surf,ienreg_surf,ienreg_surf2,display
- logical ivectplot,imeshvect,isymbols
+ logical ivectplot,imeshvect
logical topoplane,iexec,initialfield
logical imodelvect,iboundvect,usletter,compenergy
Modified: seismo/2D/SPECFEM2D/trunk/MAILLE90/maille_struct.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/MAILLE90/maille_struct.f90 2007-12-07 23:44:01 UTC (rev 8412)
+++ seismo/2D/SPECFEM2D/trunk/MAILLE90/maille_struct.f90 2007-12-07 23:44:09 UTC (rev 8413)
@@ -52,17 +52,15 @@
integer imatnum,inumabs,inumelem,nelemperio,nxgll,netyp
integer icodehaut,icodebas,icodegauche,icodedroite
integer nelemabs,npgeo,nspec,ntopo
- integer k,icol,ili,istepx,istepz,ncut,ix,iz,irec,i,j
- integer ixdebzone,ixfinzone,izdebzone,izfinzone,imodnum
- integer izone,imodele,nbzone,nbmodeles,iaffinfo
+ integer k,icol,ili,istepx,istepz,ix,iz,irec,i,j
+ integer imodele,nbmodeles,iaffinfo
integer itaff,itfirstaff,iptsdisp,isubsamp,nrec,n1ana,n2ana
integer irepr,nrec1,nrec2,isamp,nbsources,isismostype,ivecttype
integer ngnod,nt,niter,idegpoly,nx,nz,nxread,nzread
- integer inumelem2,ix2,iz2,inumperio
integer icodematread
double precision valseuil,freqmaxrep,ratio
- double precision tang1,tangN,vpzone,vszone
+ double precision tang1,tangN
double precision orig_x,orig_z,sizemax,cutvect,scalex,scalez
double precision factorxsu,factorana,xspacerec,zspacerec
double precision anglerec,anglerec2,xmin,xmax
@@ -74,7 +72,7 @@
logical abshaut,absbas,absgauche,absdroite,absstacey
logical periohaut,periogauche
logical sismos,isources_surf,ienreg_surf,ienreg_surf2,display
- logical ivectplot,imeshvect,isymbols
+ logical ivectplot,imeshvect
logical topoplane,iexec,initialfield
logical imodelvect,iboundvect,usletter,compenergy
Modified: seismo/2D/SPECFEM2D/trunk/SPECFEM90/Makefile
===================================================================
--- seismo/2D/SPECFEM2D/trunk/SPECFEM90/Makefile 2007-12-07 23:44:01 UTC (rev 8412)
+++ seismo/2D/SPECFEM2D/trunk/SPECFEM90/Makefile 2007-12-07 23:44:09 UTC (rev 8413)
@@ -14,6 +14,10 @@
#F90 = pgf90
#FLAGS=-c -fast -Mnobounds -Minline -Mneginfo -Mdclchk
+# Dec Alpha
+#F90 = f90
+#FLAGS=-c -fast -warn truncated_source -warn argument_checking -warn unused -warn declarations -std95 -check nounderflow -check bounds
+
# Intel Linux
F90 = ifort
FLAGS=-c -O3 -e95 -implicitnone
Modified: seismo/2D/SPECFEM2D/trunk/SPECFEM90/createnum_fast.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/SPECFEM90/createnum_fast.f90 2007-12-07 23:44:01 UTC (rev 8412)
+++ seismo/2D/SPECFEM2D/trunk/SPECFEM90/createnum_fast.f90 2007-12-07 23:44:09 UTC (rev 8413)
@@ -12,7 +12,7 @@
!
!=====================================================================
- subroutine createnum_fast(knods,ibool,kmato,shape,coorg,npoin,ndime,npgeo)
+ subroutine createnum_fast(knods,ibool,shape,coorg,npoin,ndime,npgeo)
!
!=======================================================================
!
@@ -34,11 +34,11 @@
implicit none
integer npoin,ndime,npgeo
- integer knods(ngnod,nspec),ibool(nxgll,nygll,nspec),kmato(nspec)
+ integer knods(ngnod,nspec),ibool(nxgll,nygll,nspec)
double precision shape(ngnod,nxgll,nxgll)
double precision coorg(ndime,npgeo)
- integer i,j,numelem
+ integer i,j
double precision, parameter :: smallvaltol = 0.000001d0
double precision, parameter :: HUGEVAL=1.0d+30
Modified: seismo/2D/SPECFEM2D/trunk/SPECFEM90/createnum_slow.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/SPECFEM90/createnum_slow.f90 2007-12-07 23:44:01 UTC (rev 8412)
+++ seismo/2D/SPECFEM2D/trunk/SPECFEM90/createnum_slow.f90 2007-12-07 23:44:09 UTC (rev 8413)
@@ -12,7 +12,7 @@
!
!=====================================================================
- subroutine createnum_slow(knods,ibool,kmato,npoin)
+ subroutine createnum_slow(knods,ibool,npoin)
!
!=======================================================================
!
@@ -27,7 +27,7 @@
implicit none
- integer knods(ngnod,nspec),ibool(nxgll,nygll,nspec),kmato(nspec)
+ integer knods(ngnod,nspec),ibool(nxgll,nygll,nspec)
integer npoin
integer i,j,num2,i2,j2,ipos,ipos2,iloc,jloc,kloc
Modified: seismo/2D/SPECFEM2D/trunk/SPECFEM90/defarrays.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/SPECFEM90/defarrays.f90 2007-12-07 23:44:01 UTC (rev 8412)
+++ seismo/2D/SPECFEM2D/trunk/SPECFEM90/defarrays.f90 2007-12-07 23:44:09 UTC (rev 8413)
@@ -71,7 +71,7 @@
double precision, parameter :: zero=0.d0,one=1.d0
- integer i,j,k
+ integer i,j
integer numelem,material
integer ipointnum,n
integer isourx,isourz,ielems,ir,is,ip,noffsetelem
Modified: seismo/2D/SPECFEM2D/trunk/SPECFEM90/getelspec.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/SPECFEM90/getelspec.f90 2007-12-07 23:44:01 UTC (rev 8412)
+++ seismo/2D/SPECFEM2D/trunk/SPECFEM90/getelspec.f90 2007-12-07 23:44:09 UTC (rev 8413)
@@ -12,7 +12,7 @@
!
!=====================================================================
- subroutine getelspec(knods,ibool,kmato,npoin,numabs,codeabs,codeperio,anyabs,anyperio)
+ subroutine getelspec(knods,kmato,numabs,codeabs,codeperio,anyabs,anyperio)
!
!=======================================================================
!
@@ -31,8 +31,7 @@
character(len=80) datlin
- integer knods(ngnod,nspec),ibool(nxgll,nygll,nspec),kmato(nspec)
- integer npoin
+ integer knods(ngnod,nspec),kmato(nspec)
integer numabs(nelemabs),codeabs(4,nelemabs)
integer codeperio(4,nelemperio)
logical anyabs,anyperio
Modified: seismo/2D/SPECFEM2D/trunk/SPECFEM90/plotpost.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/SPECFEM90/plotpost.f90 2007-12-07 23:44:01 UTC (rev 8412)
+++ seismo/2D/SPECFEM2D/trunk/SPECFEM90/plotpost.f90 2007-12-07 23:44:09 UTC (rev 8413)
@@ -63,7 +63,7 @@
double precision, parameter :: rpercentx = 70.0d0, rpercentz = 77.0d0
double precision xmax,zmax,height,xw,zw,usoffset
- integer i,iglobrec,iglobsource,ip
+ integer i,iglobrec,iglobsource
character(len=40) name
! papier A4 ou US letter
Modified: seismo/2D/SPECFEM2D/trunk/SPECFEM90/q49spec.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/SPECFEM90/q49spec.f90 2007-12-07 23:44:01 UTC (rev 8412)
+++ seismo/2D/SPECFEM2D/trunk/SPECFEM90/q49spec.f90 2007-12-07 23:44:09 UTC (rev 8413)
@@ -12,7 +12,7 @@
!
!=====================================================================
- subroutine q49spec(shape,shapeint,dershape,dvolu,xjaci,xi,yi, &
+ subroutine q49spec(shapeint,dershape,dvolu,xjaci,xi, &
coorg,knods,ngnod,nxgll,nygll,ndime,nspec,npgeo, &
xirec,etarec,flagrange,iptsdisp)
!
@@ -45,13 +45,12 @@
integer ngnod,nxgll,nygll,ndime,nspec,npgeo,iptsdisp
integer knods(ngnod,nspec)
- double precision shape(ngnod,nxgll,nxgll)
double precision shapeint(ngnod,iptsdisp,iptsdisp)
double precision dershape(ndime,ngnod,nxgll,nxgll)
double precision dvolu(nspec,nxgll,nxgll)
double precision xjaci(nspec,ndime,ndime,nxgll,nxgll)
double precision coorg(ndime,npgeo)
- double precision xi(nxgll),yi(nygll)
+ double precision xi(nxgll)
double precision xirec(iptsdisp),etarec(iptsdisp)
double precision flagrange(0:nxgll-1,iptsdisp)
Modified: seismo/2D/SPECFEM2D/trunk/SPECFEM90/qinpspec.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/SPECFEM90/qinpspec.f90 2007-12-07 23:44:01 UTC (rev 8412)
+++ seismo/2D/SPECFEM2D/trunk/SPECFEM90/qinpspec.f90 2007-12-07 23:44:09 UTC (rev 8413)
@@ -96,7 +96,7 @@
!
!---- read topology and material number for spectral elements
!
- call getelspec(knods,ibool,kmato,npoin,numabs,codeabs,codeperio,anyabs,anyperio)
+ call getelspec(knods,kmato,numabs,codeabs,codeperio,anyabs,anyperio)
!
!---- compute the spectral element shape functions and their local derivatives
@@ -109,20 +109,19 @@
! version "propre mais lente" ou version "sale mais rapide"
if(fast_numbering) then
- call createnum_fast(knods,ibool,kmato,shape,coorg,npoin,ndime,npgeo)
+ call createnum_fast(knods,ibool,shape,coorg,npoin,ndime,npgeo)
else
- call createnum_slow(knods,ibool,kmato,npoin)
+ call createnum_slow(knods,ibool,npoin)
endif
!
!---- compute the spectral element jacobian matrix
!
- call q49spec(shape,shapeint,dershape,dvolu,xjaci,xi,yi,coorg, &
+ call q49spec(shapeint,dershape,dvolu,xjaci,xi,coorg, &
knods,ngnod,nxgll,nygll,ndime,nspec,npgeo, &
xirec,etarec,flagrange,iptsdisp)
- return
!
!---- formats
!
@@ -139,3 +138,4 @@
'Number of periodic elements. . . .(nelemperio) =',i7)
end subroutine qinpspec
+
Modified: seismo/2D/SPECFEM2D/trunk/SPECFEM90/qsumspec.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/SPECFEM90/qsumspec.f90 2007-12-07 23:44:01 UTC (rev 8412)
+++ seismo/2D/SPECFEM2D/trunk/SPECFEM90/qsumspec.f90 2007-12-07 23:44:09 UTC (rev 8413)
@@ -16,7 +16,7 @@
a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13x,a13z,force, &
ibool,displ,veloc,accel,Uxnewloc,Uznewloc, &
rmass,nxgll,npoin,ndime,nspec,gltfu,nltfl,initialfield, &
- numabs,is_bordabs,nelemabs,anyabs)
+ is_bordabs,nelemabs,anyabs)
use timeparams
@@ -36,7 +36,6 @@
double precision Uxnewloc(nxgll,nxgll,nspec)
double precision Uznewloc(nxgll,nxgll,nspec)
- integer numabs(nelemabs)
integer is_bordabs(nspec)
! petits tableaux locaux (could be suppressed if needed)
@@ -62,7 +61,7 @@
double precision, external :: dirac,ricker
- integer i,j,k,l,n,isource,ielems,iglobsource,iglobnum,ip,numer_abs
+ integer i,j,k,l,n,isource,ielems,iglobsource,iglobnum,numer_abs
double precision sig
logical initialfield
Modified: seismo/2D/SPECFEM2D/trunk/SPECFEM90/specfem.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/SPECFEM90/specfem.f90 2007-12-07 23:44:01 UTC (rev 8412)
+++ seismo/2D/SPECFEM2D/trunk/SPECFEM90/specfem.f90 2007-12-07 23:44:09 UTC (rev 8413)
@@ -57,8 +57,8 @@
logical anyabs,anyperio
- integer i,it,irec,iter,itsis,iglobrec,iglobsource
- integer nbpoin,inump,n,npoinext,nseis,netyp,ipoin,ispec
+ integer i,it,irec,iter,itsis,iglobrec
+ integer nbpoin,inump,n,npoinext,nseis,netyp,ispec
double precision valux,valuz,rhoextread,vpextread,vsextread
double precision dcosrot,dsinrot,dcosrot1,dsinrot1,dcosrot2,dsinrot2
@@ -594,10 +594,8 @@
time = it*deltat
call qsumspec(hprime,hTprime, &
a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13x,a13z,force, &
- ibool,displ,veloc,accel, &
- Uxnewloc,Uznewloc,rmass,nxgll,npoin,ndime, &
- nspec,gltfu,nltfl,initialfield, &
- numabs,is_bordabs,nelemabs,anyabs)
+ ibool,displ,veloc,accel,Uxnewloc,Uznewloc,rmass,nxgll,npoin,ndime, &
+ nspec,gltfu,nltfl,initialfield,is_bordabs,nelemabs,anyabs)
!
!---- mise a jour globale du deplacement par multicorrector
More information about the cig-commits
mailing list