[cig-commits] commit: Explicitly convert to single precision and remove unused variables.
Mercurial
hg at geodynamics.org
Thu May 10 13:59:42 PDT 2012
changeset: 95:b5130569e265
user: Walter Landry <wlandry at caltech.edu>
date: Thu May 10 07:11:16 2012 -0700
files: src/fourier.f90 src/okada/green_space.f90 src/viscoelastic3d.f90
description:
Explicitly convert to single precision and remove unused variables.
diff -r 359e0a1d4722 -r b5130569e265 src/fourier.f90
--- a/src/fourier.f90 Thu May 10 07:10:35 2012 -0700
+++ b/src/fourier.f90 Thu May 10 07:11:16 2012 -0700
@@ -135,18 +135,18 @@ CONTAINS
DO i3=1,sx3
IF (i3 < sx3/2+1) THEN
- exp3=-(DBLE(i3)-1._8)
+ exp3=-REAL(DBLE(i3)-1._8,4)
ELSE
- exp3= (DBLE(sx3-i3)+1._8)
+ exp3= REAL(DBLE(sx3-i3)+1._8,4)
END IF
DO i2=1,sx2
IF (i2 < sx2/2+1) THEN
- exp2=-(DBLE(i2)-1._8)
+ exp2=-REAL(DBLE(i2)-1._8,4)
ELSE
- exp2= (DBLE(sx2-i2)+1._8)
+ exp2= REAL(DBLE(sx2-i2)+1._8,4)
END IF
DO i1=1,sx1/2+1
- exp1=(DBLE(i1)-1._8)
+ exp1=REAL(DBLE(i1)-1._8,4)
spec(2*i1-1:2*i1,i2,i3) = &
spec(2*i1-1:2*i1,i2,i3)*((-1._4)**(exp1+exp2+exp3))
END DO
@@ -193,9 +193,9 @@ CONTAINS
CALL sfftw_destroy_plan(plan)
IF (FFT_INVERSE == direction) THEN
- data=data/(sx1*dx1*sx2*dx2*sx3*dx3)
+ data=data/REAL(sx1*dx1*sx2*dx2*sx3*dx3,4)
ELSE
- data=data*(dx1*dx2*dx3)
+ data=data*REAL(dx1*dx2*dx3,4)
END IF
END SUBROUTINE fft3
@@ -375,9 +375,9 @@ CONTAINS
CALL sfftw_destroy_plan(plan)
IF (FFT_INVERSE == direction) THEN
- data=data/(sx1*dx1*sx2*dx2)
+ data=data/REAL(sx1*dx1*sx2*dx2,4)
ELSE
- data=data*(dx1*dx2)
+ data=data*REAL(dx1*dx2,4)
END IF
END SUBROUTINE fft2
@@ -619,9 +619,9 @@ CONTAINS
CALL ctfft(data,sx,1,direction,FOURT_DS,FOURT_WORK,FOURT_NW)
IF (FFT_INVERSE == direction) THEN
- data=data/(sx*dx)
+ data=data/(REAL(sx*dx,4))
ELSE
- data=data*dx
+ data=data*REAL(dx,4)
END IF
END SUBROUTINE fft1
diff -r 359e0a1d4722 -r b5130569e265 src/okada/green_space.f90
--- a/src/okada/green_space.f90 Thu May 10 07:10:35 2012 -0700
+++ b/src/okada/green_space.f90 Thu May 10 07:11:16 2012 -0700
@@ -37,7 +37,7 @@ CONTAINS
! from Okada's subroutine DC3D0:
INTEGER IRET
- REAL*4 ALPHA,X,Y,Z,DEPTH,DIP,POT1,POT2,POT3,POT4,&
+ REAL*4 ALPHA,X,Y,Z,DEPTH,DIP,POT3,POT4,&
UX,UY,UZ,UXX,UYX,UZX,UXY,UYY,UZY,UXZ,UYZ,UZZ
! more from Okada's subroutine DC3D:
@@ -47,7 +47,6 @@ CONTAINS
REAL*8 degtorad,eps
PARAMETER(degtorad=1.745329252E-02,eps=1.0d-06)
- INTEGER is
REAL*8 st,di,ra
REAL*8 csst,ssst,csra,ssra,csdi,ssdi
@@ -58,7 +57,7 @@ CONTAINS
DISL3=0.0
AL1=0.0
AW2=0.0
- Z=-zrec
+ Z=REAL(-zrec)
! initialization
disp(:)=0.d0
diff -r 359e0a1d4722 -r b5130569e265 src/viscoelastic3d.f90
--- a/src/viscoelastic3d.f90 Thu May 10 07:10:35 2012 -0700
+++ b/src/viscoelastic3d.f90 Thu May 10 07:11:16 2012 -0700
@@ -81,15 +81,15 @@ CONTAINS
(u2(i1,i2p,i3)-u2(i1,i2m,i3))/px2+&
(u3(i1,i2,i3p)-u3(i1,i2,i3m))/px3)/3._8
- s%s11=2._8*mu*( (u1(i1p,i2,i3)-u1(i1m,i2,i3))/px1-epskk )
- s%s12= mu*( (u1(i1,i2p,i3)-u1(i1,i2m,i3))/px2+ &
- (u2(i1p,i2,i3)-u2(i1m,i2,i3))/px1)
- s%s13= mu*( (u1(i1,i2,i3p)-u1(i1,i2,i3m))/px3+ &
- (u3(i1p,i2,i3)-u3(i1m,i2,i3))/px1)
- s%s22=2._8*mu*( (u2(i1,i2p,i3)-u2(i1,i2m,i3))/px2-epskk )
- s%s23= mu*( (u2(i1,i2,i3p)-u2(i1,i2,i3m))/px3+ &
- (u3(i1,i2p,i3)-u3(i1,i2m,i3))/px2)
- s%s33=2._8*mu*( (u3(i1,i2,i3p)-u3(i1,i2,i3m))/px3-epskk )
+ s%s11=REAL(2._8*mu*( (u1(i1p,i2,i3)-u1(i1m,i2,i3))/px1-epskk ))
+ s%s12=REAL(mu*( (u1(i1,i2p,i3)-u1(i1,i2m,i3))/px2+ &
+ (u2(i1p,i2,i3)-u2(i1m,i2,i3))/px1))
+ s%s13=REAL(mu*( (u1(i1,i2,i3p)-u1(i1,i2,i3m))/px3+ &
+ (u3(i1p,i2,i3)-u3(i1m,i2,i3))/px1))
+ s%s22=REAL(2._8*mu*( (u2(i1,i2p,i3)-u2(i1,i2m,i3))/px2-epskk ))
+ s%s23=REAL(mu*( (u2(i1,i2,i3p)-u2(i1,i2,i3m))/px3+ &
+ (u3(i1,i2p,i3)-u3(i1,i2m,i3))/px2))
+ s%s33=REAL(2._8*mu*( (u3(i1,i2,i3p)-u3(i1,i2,i3m))/px3-epskk ))
sig(i1,i2,i3)= s .minus. tau(i1,i2,i3)
@@ -200,10 +200,10 @@ CONTAINS
moment(i1,i2,i3)=moment(i1,i2,i3) .plus. &
(REAL(2._8*mu*gammadot) .times. R)
- tm=MIN(tm,tauc/mu/gammadot)
+ tm=MIN(tm,REAL(tauc/mu/gammadot))
IF (PRESENT(gamma)) &
- gamma(i1,i2,i3)=gammadot
+ gamma(i1,i2,i3)=REAL(gammadot)
END DO
END DO
More information about the CIG-COMMITS
mailing list