research/incomp-flame-post
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

module compact real precision rewritten using kind= syntax

Browse source
This commit is contained in:
ignis 2019-07-06 17:15:50 +09:00
parent 45b298d460
commit b7a16a467e
1 changed files with 35 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

68
code/Compact.f90
View file

@ -1,11 +1,13 @@
MODULE Compact MODULE Compact
IMPLICIT NONE IMPLICIT NONE
REAL*8, DIMENSION(:), ALLOCATABLE :: lxf,lxs,wxf,wxs, &
lyf,lys,wyf,wys, & REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: lxf,lxs,wxf,wxs, &
lzf,lzs,wzf,wzs lyf,lys,wyf,wys, &
! lyzf,lyzs,wyzf,wyzs lzf,lzs,wzf,wzs
INTEGER :: nxc,nyc,nzc INTEGER :: nxc,nyc,nzc
REAL*8, PARAMETER :: ezero = 1.0e-14
REAL(KIND=8), PARAMETER :: ezero = 1.0e-14
CONTAINS CONTAINS
@ -155,7 +157,7 @@
SUBROUTINE nonp_lud(xyz,xx) SUBROUTINE nonp_lud(xyz,xx)
INTEGER :: i,xyz,xx INTEGER :: i,xyz,xx
REAL*8, DIMENSION(xx) :: aa REAL(KIND=8), DIMENSION(xx) :: aa
aa=3. aa=3.
aa(1)=0.5 ; aa(2)=4. aa(1)=0.5 ; aa(2)=4.
aa(xx-1)=4. ; aa(xx)=0.5 aa(xx-1)=4. ; aa(xx)=0.5
@ -175,7 +177,7 @@
SUBROUTINE p_lud(xyz,xx) SUBROUTINE p_lud(xyz,xx)
INTEGER :: i,xyz,xx INTEGER :: i,xyz,xx
REAL*8 :: a REAL(KIND=8) :: a
a=3. ! first derivative a=3. ! first derivative
IF (xyz.eq.1) CALL ptdlu(a,xx,lxf,wxf) ! x-direction IF (xyz.eq.1) CALL ptdlu(a,xx,lxf,wxf) ! x-direction
IF (xyz.eq.2) CALL ptdlu(a,xx,lyf,wyf) ! y-direction IF (xyz.eq.2) CALL ptdlu(a,xx,lyf,wyf) ! y-direction
@ -188,8 +190,8 @@
SUBROUTINE stdlu(a,n,l) SUBROUTINE stdlu(a,n,l)
INTEGER :: n INTEGER :: n
REAL*8 :: a(n),l(n) REAL(KIND=8) :: a(n),l(n)
REAL*8 :: d REAL(KIND=8) :: d
INTEGER :: i INTEGER :: i
l(1)=1.0/a(1) l(1)=1.0/a(1)
DO i=2,n DO i=2,n
@ -200,9 +202,9 @@
SUBROUTINE ptdlu(a,n,l,w) SUBROUTINE ptdlu(a,n,l,w)
INTEGER :: n INTEGER :: n
REAL*8 :: a,l(n),w(n) REAL(KIND=8) :: a,l(n),w(n)
INTEGER :: i INTEGER :: i
REAL*8 :: aa(n),d REAL(KIND=8) :: aa(n),d
DO i=1,n-1 DO i=1,n-1
aa(i)=a aa(i)=a
@ -226,11 +228,11 @@
SUBROUTINE dfnonp(n,h,x,dx,nd,dir) SUBROUTINE dfnonp(n,h,x,dx,nd,dir)
INTEGER,INTENT(IN) :: n,nd,dir INTEGER,INTENT(IN) :: n,nd,dir
REAL*8,INTENT(IN) :: h REAL(KIND=8),INTENT(IN) :: h
REAL*8,INTENT(IN),DIMENSION(nd,n) :: x REAL(KIND=8),INTENT(IN),DIMENSION(nd,n) :: x
REAL*8,INTENT(OUT),DIMENSION(nd,n) :: dx REAL(KIND=8),INTENT(OUT),DIMENSION(nd,n) :: dx
INTEGER :: i,j 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 ! print *, "dfnonp received (nd,n)", nd, n
@ -271,11 +273,11 @@
SUBROUTINE dfp(n,h,x,dx,nd,dir) SUBROUTINE dfp(n,h,x,dx,nd,dir)
INTEGER,INTENT(IN) :: n,nd,dir INTEGER,INTENT(IN) :: n,nd,dir
REAL*8,INTENT(IN) :: h REAL(KIND=8),INTENT(IN) :: h
REAL*8,INTENT(IN),DIMENSION(nd,n) :: x REAL(KIND=8),INTENT(IN),DIMENSION(nd,n) :: x
REAL*8,INTENT(OUT),DIMENSION(nd,n) :: dx REAL(KIND=8),INTENT(OUT),DIMENSION(nd,n) :: dx
INTEGER :: i,j INTEGER :: i,j
REAL*8 :: r1,r2,h1 REAL(KIND=8) :: r1,r2,h1
! print *, "dfnonp received (nd,n)", nd, n ! print *, "dfnonp received (nd,n)", nd, n
@ -310,10 +312,10 @@
SUBROUTINE ptdslv(r,n,l,w,nd) SUBROUTINE ptdslv(r,n,l,w,nd)
INTEGER,INTENT(IN) :: n,nd INTEGER,INTENT(IN) :: n,nd
REAL*8,INTENT(INOUT),DIMENSION(nd,n) :: r REAL(KIND=8),INTENT(INOUT),DIMENSION(nd,n) :: r
REAL*8,INTENT(IN),DIMENSION(:) :: l,w REAL(KIND=8),INTENT(IN),DIMENSION(:) :: l,w
INTEGER i,j INTEGER i,j
REAL*8, DIMENSION(nd) :: sum REAL(KIND=8), DIMENSION(nd) :: sum
DO j=1,nd DO j=1,nd
sum(j)=w(1)*r(j,1) sum(j)=w(1)*r(j,1)
r(j,1)=r(j,1)*l(1) r(j,1)=r(j,1)*l(1)
@ -338,11 +340,11 @@
SUBROUTINE d2fp(n,h,x,dx,nd,dir) SUBROUTINE d2fp(n,h,x,dx,nd,dir)
INTEGER,INTENT(IN) :: n,nd,dir INTEGER,INTENT(IN) :: n,nd,dir
REAL*8,INTENT(IN) :: h REAL(KIND=8),INTENT(IN) :: h
REAL*8,INTENT(IN),DIMENSION(nd,n) :: x REAL(KIND=8),INTENT(IN),DIMENSION(nd,n) :: x
REAL*8,INTENT(OUT),DIMENSION(nd,n) :: dx REAL(KIND=8),INTENT(OUT),DIMENSION(nd,n) :: dx
INTEGER :: i,j INTEGER :: i,j
REAL*8 :: h2,r1,r2,t1,t2 REAL(KIND=8) :: h2,r1,r2,t1,t2
h2=1./(h*h) h2=1./(h*h)
@ -403,10 +405,10 @@
SUBROUTINE tdslv(r,n,l,nd) SUBROUTINE tdslv(r,n,l,nd)
INTEGER,INTENT(IN) :: n,nd INTEGER,INTENT(IN) :: n,nd
REAL*8,INTENT(INOUT),DIMENSION(nd,n) :: r REAL(KIND=8),INTENT(INOUT),DIMENSION(nd,n) :: r
REAL*8,INTENT(IN),DIMENSION(:) :: l REAL(KIND=8),INTENT(IN),DIMENSION(:) :: l
INTEGER i,j INTEGER i,j
REAL*8 t1 REAL(KIND=8) t1
DO j=1,nd DO j=1,nd
r(j,1)=r(j,1)*l(1) r(j,1)=r(j,1)*l(1)
ENDDO ENDDO
@ -425,11 +427,11 @@
SUBROUTINE d2fnonp(n,h,x,dx,nd,dir) SUBROUTINE d2fnonp(n,h,x,dx,nd,dir)
INTEGER,INTENT(IN) :: n,nd,dir INTEGER,INTENT(IN) :: n,nd,dir
REAL*8,INTENT(IN) :: h REAL(KIND=8),INTENT(IN) :: h
REAL*8,INTENT(IN),DIMENSION(nd,n) :: x REAL(KIND=8),INTENT(IN),DIMENSION(nd,n) :: x
REAL*8,INTENT(OUT),DIMENSION(nd,n) :: dx REAL(KIND=8),INTENT(OUT),DIMENSION(nd,n) :: dx
INTEGER :: i,j 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) h2=1./(h*h)