diff options
Diffstat (limited to 'examples/fortran')
| -rw-r--r-- | examples/fortran/README | 10 | ||||
| -rw-r--r-- | examples/fortran/ccd.f | 32 | ||||
| -rw-r--r-- | examples/fortran/ccd.script | 18 | ||||
| -rw-r--r-- | examples/fortran/gemm.f90 | 58 | ||||
| -rw-r--r-- | examples/fortran/gemm.script | 30 | ||||
| -rw-r--r-- | examples/fortran/rose_gemm.f90 | 155 |
6 files changed, 303 insertions, 0 deletions
diff --git a/examples/fortran/README b/examples/fortran/README new file mode 100644 index 0000000..4f23bee --- /dev/null +++ b/examples/fortran/README @@ -0,0 +1,10 @@ +// Manu + +1) Fortran support added to permute, tile, unroll and datacopy. Tested these w.r.t gemm.c using gemm.script. + There might be other issues (like fusion due to unroll, ...) that have not been tested. + +2) To incorporate Fortran support I had to modify certain values in omega (include/omega/omega_core/oc.h). + To solve for large number of unknowns, these values have to be reverted back. + +3) Tested the existing chill scripts using Derick's python script. + At least the existing chill scripts are not affected by the fortran related changes. diff --git a/examples/fortran/ccd.f b/examples/fortran/ccd.f new file mode 100644 index 0000000..12d834d --- /dev/null +++ b/examples/fortran/ccd.f @@ -0,0 +1,32 @@ +c +c These have been separated out from ccsd_t_singles_l.F and ccsd_t_doubles_l.F +c + subroutine clean_sd_t_s1_1(h3d,h2d,h1d,p6d,p5d,p4d, + 2 triplesx,t1sub,v2sub) + IMPLICIT NONE + integer h3d,h2d,h1d,p6d,p5d,p4d + integer h3,h2,h1,p6,p5,p4 + integer N + double precision triplesx(16,16,16,16,16,16) + double precision t1sub(16,16) + double precision v2sub(16,16,16,16) + + N = 16 + + do p4=1,10 + do p5=1,10 + do p6=1,10 + do h1=1,10 + do h2=1,10 + do h3=1,10 + triplesx(h3,h2,h1,p6,p5,p4)=triplesx(h3,h2,h1,p6,p5,p4) + 1 + t1sub(p4,h1)*v2sub(h3,h2,p6,p5) + enddo + enddo + enddo + enddo + enddo + enddo + return + end + diff --git a/examples/fortran/ccd.script b/examples/fortran/ccd.script new file mode 100644 index 0000000..c2af500 --- /dev/null +++ b/examples/fortran/ccd.script @@ -0,0 +1,18 @@ +source: ccd.f +procedure: clean_sd_t_s1_1 +format : rose +loop: 0 + + + +original() + +UN=4 + +unroll(0,5,4) +unroll(0,4,4) +unroll(0,3,4) +unroll(0,2,4) +unroll(0,1,4) + +print diff --git a/examples/fortran/gemm.f90 b/examples/fortran/gemm.f90 new file mode 100644 index 0000000..b65bb58 --- /dev/null +++ b/examples/fortran/gemm.f90 @@ -0,0 +1,58 @@ +program matmul + + integer N,i,j,k + real*8 a(10,10), b(10,10), c(10,10), ct(10,10),mysum + + do i=1,10,1 + do j=1,10,1 + a(i,j) = i+j + b(i,j) = i-j + c(i,j) = 0.0 + ct(i,j) = 0.0 + end do + b(i,i) = 1.0; + end do + + + DO j=1,10,1 + DO k=1,10,1 + DO i=1,10,1 + c(i,j) = c(i,j)+a(i,k)*b(k,j) + end do + end do + end do + + + + call gemm(10,a,b,ct) + + mysum = 0.0 + do i=1,10,1 + do j=1,10,1 + mysum = c(i,j) - ct(i,j) + end do + end do + + if (abs(mysum) >= 0.00001) then + write (*,*) "Something wrong" + else + write (*,*) "Output matches" + end if + +end program matmul + + SUBROUTINE gemm(N,A,B,C) + INTEGER N + REAL*8 A(N,N), B(N,N), C(N,N) + + INTEGER I,J,K + + DO J=1,N,1 + DO K=1,N,1 + DO I=1,N,1 + C(I,J) = C(I,J)+A(I,K)*B(K,J) + end do + end do + end do + + END subroutine diff --git a/examples/fortran/gemm.script b/examples/fortran/gemm.script new file mode 100644 index 0000000..01eb859 --- /dev/null +++ b/examples/fortran/gemm.script @@ -0,0 +1,30 @@ +#matrix multiply large array size for intel machine +source: gemm.f90 +procedure: gemm +format: rose +loop: 0 + +TI = 128 +#TI = 4 +TJ = 8 +#TK = 3 +TK = 512 +UI = 2 +UJ = 2 + +permute([3,1,2]) +tile(0,2,TJ) +#print space +tile(0,2,TI) +#print space +tile(0,5,TK) +#print space + + +datacopy(0,3,A,false,-1) +#print space + +datacopy(0,4,B) +unroll(0,4,UI) +unroll(0,5,UJ) + diff --git a/examples/fortran/rose_gemm.f90 b/examples/fortran/rose_gemm.f90 new file mode 100644 index 0000000..d150922 --- /dev/null +++ b/examples/fortran/rose_gemm.f90 @@ -0,0 +1,155 @@ +PROGRAM matmul +INTEGER :: N, i, j, k +REAL(kind=8) :: a(10,10), b(10,10), c(10,10), ct(10,10), mysum +DO i = 1, 10, 1 +DO j = 1, 10, 1 +a(i,j) = i + j +b(i,j) = i - j +c(i,j) = 0.0 +ct(i,j) = 0.0 +END DO +b(i,i) = 1.0 +END DO +DO j = 1, 10, 1 +DO k = 1, 10, 1 +DO i = 1, 10, 1 +c(i,j) = c(i,j) + a(i,k) * b(k,j) +END DO +END DO +END DO +CALL gemm(10,a,b,ct) +mysum = 0.0 +DO i = 1, 10, 1 +DO j = 1, 10, 1 +mysum = c(i,j) - ct(i,j) +END DO +END DO +IF (abs(mysum) >= 0.00001) THEN +WRITE (*, FMT=*) "Something wrong" +ELSE +WRITE (*, FMT=*) "Output matches" +END IF +END PROGRAM matmul + +SUBROUTINE gemm(N,A,B,C) +INTEGER :: t12 +INTEGER :: t10 +INTEGER :: t8 +INTEGER :: t6 +INTEGER :: t4 +INTEGER :: t2 +INTEGER :: chill_t64 +INTEGER :: chill_t63 +INTEGER :: chill_t62 +INTEGER :: chill_t61 +INTEGER :: chill_t60 +INTEGER :: chill_t59 +INTEGER :: chill_t58 +INTEGER :: chill_t57 +INTEGER :: chill_t56 +INTEGER :: chill_t55 +INTEGER :: chill_t54 +INTEGER :: chill_t53 +INTEGER :: chill_t52 +INTEGER :: chill_t51 +INTEGER :: chill_t50 +INTEGER :: chill_t49 +INTEGER :: chill_t48 +INTEGER :: chill_t47 +INTEGER :: over2 +INTEGER :: chill_t46 +INTEGER :: chill_t45 +INTEGER :: chill_t44 +INTEGER :: chill_t43 +INTEGER :: chill_t42 +INTEGER :: chill_t41 +INTEGER :: chill_t40 +INTEGER :: chill_t39 +INTEGER :: chill_t38 +INTEGER :: chill_t37 +INTEGER :: chill_t36 +INTEGER :: chill_t35 +INTEGER :: chill_t34 +INTEGER :: chill_t33 +INTEGER :: chill_t32 +INTEGER :: chill_t31 +INTEGER :: chill_t30 +INTEGER :: chill_t29 +INTEGER :: chill_t28 +INTEGER :: chill_t27 +INTEGER :: chill_t26 +INTEGER :: chill_t25 +INTEGER :: chill_t24 +INTEGER :: chill_t23 +INTEGER :: over1 +INTEGER :: chill_t22 +INTEGER :: chill_t21 +INTEGER :: chill_t20 +INTEGER :: chill_t19 +INTEGER :: chill_t18 +INTEGER :: chill_t17 +INTEGER :: chill_t16 +INTEGER :: chill_t15 +REAL(kind=8), DIMENSION(8,512) :: f_P2 +INTEGER :: chill_t14 +INTEGER :: chill_t13 +INTEGER :: chill_t12 +INTEGER :: chill_t11 +INTEGER :: chill_t10 +INTEGER :: chill_t9 +INTEGER :: chill_t8 +INTEGER :: chill_t7 +REAL(kind=8), DIMENSION(512,128) :: f_P1 +INTEGER :: chill_t1 +INTEGER :: chill_t2 +INTEGER :: chill_t4 +INTEGER :: chill_t6 +INTEGER :: chill_t5 +INTEGER :: N +REAL(kind=8) :: A(N,N), B(N,N), C(N,N) +INTEGER :: I, J, K +over1 = 0 +over2 = 0 +DO t2 = 1, N, 512 +DO t4 = 1, N, 128 +DO t6 = t2, merge(N,t2 + 511,N <= t2 + 511), 1 +DO t8 = t4, merge(t4 + 127,N,t4 + 127 <= N), 1 +f_P1(t8 - t4 + 1,t6 - t2 + 1) = A(t8,t6) +END DO +END DO +DO t6 = 1, N, 8 +DO t8 = t6, merge(N,t6 + 7,N <= t6 + 7), 1 +DO t10 = t2, merge(N,t2 + 511,N <= t2 + 511), 1 +f_P2(t10 - t2 + 1,t8 - t6 + 1) = B(t10,t8) +END DO +END DO +over1 = MOD(N,2) +DO t8 = t4, merge(-over1 + N,t4 + 126,-over1 + N <= t4 + 126), 2 +over2 = MOD(N,2) +DO t10 = t6, merge(t6 + 6,N - over2,t6 + 6 <= N - over2), 2 +DO t12 = t2, merge(t2 + 511,N,t2 + 511 <= N), 1 +C(t8,t10) = C(t8,t10) + f_P1(t8 - t4 + 1,t12 - t2 + 1) * f_P2(t12 - t2 + 1,t10 - t6 + 1) +C(t8 + 1,t10) = C(t8 + 1,t10) + f_P1(t8 + 1 - t4 + 1,t12 - t2 + 1) * f_P2(t12 - t2 + 1,t10 - t6 + 1) +C(t8,t10 + 1) = C(t8,t10 + 1) + f_P1(t8 - t4 + 1,t12 - t2 + 1) * f_P2(t12 - t2 + 1,t10 + 1 - t6 + 1) +C(t8 + 1,t10 + 1) = C(t8 + 1,t10 + 1) + f_P1(t8 + 1 - t4 + 1,t12 - t2 + 1) * f_P2(t12 - t2 + 1,t10 + 1 - t6 + 1) +END DO +END DO +IF (N - 7 <= t6 .AND. 1 <= over2) THEN +DO t12 = t2, merge(N,t2 + 511,N <= t2 + 511), 1 +C(t8,N) = C(t8,N) + f_P1(t8 - t4 + 1,t12 - t2 + 1) * f_P2(t12 - t2 + 1,N - t6 + 1) +C(t8 + 1,N) = C(t8 + 1,N) + f_P1(t8 + 1 - t4 + 1,t12 - t2 + 1) * f_P2(t12 - t2 + 1,N - t6 + 1) +END DO +END IF +END DO +IF (N - 127 <= t4 .AND. 1 <= over1) THEN +DO t10 = t6, merge(t6 + 7,N,t6 + 7 <= N), 1 +DO t12 = t2, merge(t2 + 511,N,t2 + 511 <= N), 1 +C(N,t10) = C(N,t10) + f_P1(N - t4 + 1,t12 - t2 + 1) * f_P2(t12 - t2 + 1,t10 - t6 + 1) +END DO +END DO +END IF +END DO +END DO +END DO +END SUBROUTINE + |