[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