[cig-commits] commit: Explicitly cast to single precision. Also change COMPLEX*8 to
Mercurial
hg at geodynamics.org
Thu May 10 13:59:40 PDT 2012
changeset: 94:359e0a1d4722
user: Walter Landry <wlandry at caltech.edu>
date: Thu May 10 07:10:35 2012 -0700
files: src/green.f90
description:
Explicitly cast to single precision. Also change COMPLEX*8 to
COMPLEX(KIND=8), because I was getting compiler warnings about
converting to single precision with COMPLEX*8.
diff -r f91bf92135c0 -r 359e0a1d4722 src/green.f90
--- a/src/green.f90 Thu May 10 07:08:47 2012 -0700
+++ b/src/green.f90 Thu May 10 07:10:35 2012 -0700
@@ -117,7 +117,7 @@ CONTAINS
INTEGER :: i1, i2, i3, sx1, sx2, sx3
REAL*8 :: k1, k2, k3, modulus
COMPLEX*8, PARAMETER :: i = CMPLX(0._8,pi2)
- COMPLEX*8 :: sum, c1, c2, c3
+ COMPLEX(KIND=8) :: sum, c1, c2, c3
sx1=SIZE(u1,1)-2
sx2=SIZE(u1,2)
@@ -142,7 +142,7 @@ CONTAINS
END DO
END DO
END DO
- p=p/(sx3*dx3)
+ p=REAL(p/(sx3*dx3),4)
END SUBROUTINE surfacenormaltraction
@@ -232,12 +232,12 @@ CONTAINS
u2=CMPLX(0.,0.)
u3=CMPLX(0.,0.)
ELSE
- b=p/(2._8*mu*alpha*beta**3._8)
- u1=i*alpha*pi2*beta*b*(1._8-1._8/alpha+beta*x3)*depthdecay
+ b=CMPLX(p/(2._8*mu*alpha*beta**3._8))
+ u1=CMPLX(i*alpha*pi2*beta*b*(1._8-1._8/alpha+beta*x3)*depthdecay)
u2=u1
- u1=u1*k1
- u2=u2*k2
- u3=-p/(2*mu*beta)*(1._8/alpha+beta*x3)*depthdecay
+ u1=CMPLX(u1*k1)
+ u2=CMPLX(u2*k2)
+ u3=CMPLX(-p/(2*mu*beta)*(1._8/alpha+beta*x3)*depthdecay)
END IF
END SUBROUTINE steketeesolution
@@ -301,9 +301,9 @@ CONTAINS
END DO
!$omp end parallel do
- p1=p1/(sx3*dx3)
- p2=p2/(sx3*dx3)
- p3=p3/(sx3*dx3)
+ p1=p1/REAL(sx3*dx3,4)
+ p2=p2/REAL(sx3*dx3,4)
+ p3=p3/REAL(sx3*dx3,4)
END SUBROUTINE surfacetraction
@@ -332,8 +332,8 @@ CONTAINS
INTEGER :: i1,i2,i3,sx1,sx2,sx3
REAL*8 :: k1,k2,k3,modulus,alpha,grav
- COMPLEX*8, PARAMETER :: i=CMPLX(0._8,pi2)
- COMPLEX*8 :: sum1,sum2,sum3,c1,c2,c3
+ COMPLEX(KIND=8), PARAMETER :: i=CMPLX(0._8,pi2)
+ COMPLEX(KIND=8) :: sum1,sum2,sum3,c1,c2,c3
sx1=SIZE(u1,1)-2
sx2=SIZE(u1,2)
@@ -362,17 +362,17 @@ CONTAINS
sum2=i*mu*(k3*c2+k2*c3)
sum3=i*(modulus*k3*c3+lambda*(k1*c1+k2*c2))-grav*c3
- p1(2*i1-1:2*i1,i2)=p1(2*i1-1:2*i1,i2)+(/REAL(sum1),AIMAG(sum1)/)
- p2(2*i1-1:2*i1,i2)=p2(2*i1-1:2*i1,i2)+(/REAL(sum2),AIMAG(sum2)/)
- p3(2*i1-1:2*i1,i2)=p3(2*i1-1:2*i1,i2)+(/REAL(sum3),AIMAG(sum3)/)
+ p1(2*i1-1:2*i1,i2)=p1(2*i1-1:2*i1,i2)+(/REAL(sum1,4),REAL(AIMAG(sum1),4)/)
+ p2(2*i1-1:2*i1,i2)=p2(2*i1-1:2*i1,i2)+(/REAL(sum2,4),REAL(AIMAG(sum2),4)/)
+ p3(2*i1-1:2*i1,i2)=p3(2*i1-1:2*i1,i2)+(/REAL(sum3,4),REAL(AIMAG(sum3),4)/)
END DO
END DO
END DO
!$omp end parallel do
- p1=p1/(sx3*dx3)
- p2=p2/(sx3*dx3)
- p3=p3/(sx3*dx3)
+ p1=p1/REAL(sx3*dx3,4)
+ p2=p2/REAL(sx3*dx3,4)
+ p3=p3/REAL(sx3*dx3,4)
END SUBROUTINE surfacetractioncowling
@@ -509,9 +509,9 @@ CONTAINS
v3=v3+b1*i*k1*beta*(1._8/alpha-1._8+beta*x3)
! b2 contribution & switch to single-precision
- u1=v1+b2*k1*k2*temp
- u2=v2+b2*(-2._8*beta**2+k2**2*temp)
- u3=v3+b2*i*k2*beta*(1._8/alpha-1._8+beta*x3)
+ u1=CMPLX(v1+b2*k1*k2*temp)
+ u2=CMPLX(v2+b2*(-2._8*beta**2+k2**2*temp))
+ u3=CMPLX(v3+b2*i*k2*beta*(1._8/alpha-1._8+beta*x3))
END IF
END SUBROUTINE cerrutisolution
@@ -677,9 +677,9 @@ CONTAINS
v3=v3+b1*i*k1*beta*(1._8/alpha-1._8+beta*x3)/(1+h)
! b2 contribution & switch to single-precision
- u1=v1+b2*k1*k2*temp
- u2=v2+b2*(-2._8*beta**2+k2**2*temp)
- u3=v3+b2*i*k2*beta*(1._8/alpha-1._8+beta*x3)/(1+h)
+ u1=CMPLX(v1+b2*k1*k2*temp)
+ u2=CMPLX(v2+b2*(-2._8*beta**2+k2**2*temp))
+ u3=CMPLX(v3+b2*i*k2*beta*(1._8/alpha-1._8+beta*x3)/(1+h))
END IF
END SUBROUTINE cerrutisolcowling
@@ -799,9 +799,9 @@ CONTAINS
v3=v3+b1*i*k1*beta*(1._8/alpha-1._8+beta*x3)/(1+h)
! b2 contribution & switch to single-precision
- u1=v1+b2*k1*k2*temp
- u2=v2+b2*(-2._8*beta**2+k2**2*temp)
- u3=v3+b2*i*k2*beta*(1._8/alpha-1._8+beta*x3)/(1+h)
+ u1=CMPLX(v1+b2*k1*k2*temp)
+ u2=CMPLX(v2+b2*(-2._8*beta**2+k2**2*temp))
+ u3=CMPLX(v3+b2*i*k2*beta*(1._8/alpha-1._8+beta*x3)/(1+h))
END IF
END SUBROUTINE cerrutisolcowling
More information about the CIG-COMMITS
mailing list