From b7a16a467eae49f8e295a67ce52499fb1cf1d139 Mon Sep 17 00:00:00 2001 From: ignis Date: Sat, 6 Jul 2019 17:15:50 +0900 Subject: [PATCH] module compact real precision rewritten using kind= syntax --- code/Compact.f90 | 68 +++++++++++++++++++++++++----------------------- 1 file changed, 35 insertions(+), 33 deletions(-) diff --git a/code/Compact.f90 b/code/Compact.f90 index 6c4ff64..46b292b 100644 --- a/code/Compact.f90 +++ b/code/Compact.f90 @@ -1,11 +1,13 @@ MODULE Compact IMPLICIT NONE - REAL*8, DIMENSION(:), ALLOCATABLE :: lxf,lxs,wxf,wxs, & - lyf,lys,wyf,wys, & - lzf,lzs,wzf,wzs -! lyzf,lyzs,wyzf,wyzs + + REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: lxf,lxs,wxf,wxs, & + lyf,lys,wyf,wys, & + lzf,lzs,wzf,wzs + INTEGER :: nxc,nyc,nzc - REAL*8, PARAMETER :: ezero = 1.0e-14 + + REAL(KIND=8), PARAMETER :: ezero = 1.0e-14 CONTAINS @@ -155,7 +157,7 @@ SUBROUTINE nonp_lud(xyz,xx) INTEGER :: i,xyz,xx - REAL*8, DIMENSION(xx) :: aa + REAL(KIND=8), DIMENSION(xx) :: aa aa=3. aa(1)=0.5 ; aa(2)=4. aa(xx-1)=4. ; aa(xx)=0.5 @@ -175,7 +177,7 @@ SUBROUTINE p_lud(xyz,xx) INTEGER :: i,xyz,xx - REAL*8 :: a + REAL(KIND=8) :: a a=3. ! first derivative IF (xyz.eq.1) CALL ptdlu(a,xx,lxf,wxf) ! x-direction IF (xyz.eq.2) CALL ptdlu(a,xx,lyf,wyf) ! y-direction @@ -188,8 +190,8 @@ SUBROUTINE stdlu(a,n,l) INTEGER :: n - REAL*8 :: a(n),l(n) - REAL*8 :: d + REAL(KIND=8) :: a(n),l(n) + REAL(KIND=8) :: d INTEGER :: i l(1)=1.0/a(1) DO i=2,n @@ -200,9 +202,9 @@ SUBROUTINE ptdlu(a,n,l,w) INTEGER :: n - REAL*8 :: a,l(n),w(n) + REAL(KIND=8) :: a,l(n),w(n) INTEGER :: i - REAL*8 :: aa(n),d + REAL(KIND=8) :: aa(n),d DO i=1,n-1 aa(i)=a @@ -226,11 +228,11 @@ SUBROUTINE dfnonp(n,h,x,dx,nd,dir) INTEGER,INTENT(IN) :: n,nd,dir - REAL*8,INTENT(IN) :: h - REAL*8,INTENT(IN),DIMENSION(nd,n) :: x - REAL*8,INTENT(OUT),DIMENSION(nd,n) :: dx + REAL(KIND=8),INTENT(IN) :: h + REAL(KIND=8),INTENT(IN),DIMENSION(nd,n) :: x + REAL(KIND=8),INTENT(OUT),DIMENSION(nd,n) :: dx INTEGER :: i,j - REAL*8 :: r1,r2,r3,a,b,c,h1,t1,t2,t3,t4 + REAL(KIND=8) :: r1,r2,r3,a,b,c,h1,t1,t2,t3,t4 ! print *, "dfnonp received (nd,n)", nd, n @@ -271,11 +273,11 @@ SUBROUTINE dfp(n,h,x,dx,nd,dir) INTEGER,INTENT(IN) :: n,nd,dir - REAL*8,INTENT(IN) :: h - REAL*8,INTENT(IN),DIMENSION(nd,n) :: x - REAL*8,INTENT(OUT),DIMENSION(nd,n) :: dx + REAL(KIND=8),INTENT(IN) :: h + REAL(KIND=8),INTENT(IN),DIMENSION(nd,n) :: x + REAL(KIND=8),INTENT(OUT),DIMENSION(nd,n) :: dx INTEGER :: i,j - REAL*8 :: r1,r2,h1 + REAL(KIND=8) :: r1,r2,h1 ! print *, "dfnonp received (nd,n)", nd, n @@ -310,10 +312,10 @@ SUBROUTINE ptdslv(r,n,l,w,nd) INTEGER,INTENT(IN) :: n,nd - REAL*8,INTENT(INOUT),DIMENSION(nd,n) :: r - REAL*8,INTENT(IN),DIMENSION(:) :: l,w + REAL(KIND=8),INTENT(INOUT),DIMENSION(nd,n) :: r + REAL(KIND=8),INTENT(IN),DIMENSION(:) :: l,w INTEGER i,j - REAL*8, DIMENSION(nd) :: sum + REAL(KIND=8), DIMENSION(nd) :: sum DO j=1,nd sum(j)=w(1)*r(j,1) r(j,1)=r(j,1)*l(1) @@ -338,11 +340,11 @@ SUBROUTINE d2fp(n,h,x,dx,nd,dir) INTEGER,INTENT(IN) :: n,nd,dir - REAL*8,INTENT(IN) :: h - REAL*8,INTENT(IN),DIMENSION(nd,n) :: x - REAL*8,INTENT(OUT),DIMENSION(nd,n) :: dx + REAL(KIND=8),INTENT(IN) :: h + REAL(KIND=8),INTENT(IN),DIMENSION(nd,n) :: x + REAL(KIND=8),INTENT(OUT),DIMENSION(nd,n) :: dx INTEGER :: i,j - REAL*8 :: h2,r1,r2,t1,t2 + REAL(KIND=8) :: h2,r1,r2,t1,t2 h2=1./(h*h) @@ -403,10 +405,10 @@ SUBROUTINE tdslv(r,n,l,nd) INTEGER,INTENT(IN) :: n,nd - REAL*8,INTENT(INOUT),DIMENSION(nd,n) :: r - REAL*8,INTENT(IN),DIMENSION(:) :: l + REAL(KIND=8),INTENT(INOUT),DIMENSION(nd,n) :: r + REAL(KIND=8),INTENT(IN),DIMENSION(:) :: l INTEGER i,j - REAL*8 t1 + REAL(KIND=8) t1 DO j=1,nd r(j,1)=r(j,1)*l(1) ENDDO @@ -425,11 +427,11 @@ SUBROUTINE d2fnonp(n,h,x,dx,nd,dir) INTEGER,INTENT(IN) :: n,nd,dir - REAL*8,INTENT(IN) :: h - REAL*8,INTENT(IN),DIMENSION(nd,n) :: x - REAL*8,INTENT(OUT),DIMENSION(nd,n) :: dx + REAL(KIND=8),INTENT(IN) :: h + REAL(KIND=8),INTENT(IN),DIMENSION(nd,n) :: x + REAL(KIND=8),INTENT(OUT),DIMENSION(nd,n) :: dx INTEGER :: i,j - REAL*8 :: h2,r1,r2,r3,a,b,c,e,t1,t2 + REAL(KIND=8) :: h2,r1,r2,r3,a,b,c,e,t1,t2 h2=1./(h*h)