support module for mini language

code/m_calculate.f90

@@ -0,0 +1,110 @@
+module m_calculate
+
+  use Compact
+  use m_parameters
+
+  implicit none
+
+    real*8, allocatable :: work(:,:,:,:)
+
+    real*8, allocatable, dimension(:,:) :: xsrc, ysrc, zsrc
+    real*8, allocatable, dimension(:,:) :: xdst, ydst, zdst
+
+    integer, parameter :: nb = 16
+
+    private :: work, nb
+    private :: xsrc, ysrc, zsrc
+    private :: xdst, ydst, zdst
+
+contains
+
+     subroutine m_calculate_init
+     
+     integer :: ierr
+
+     allocate(work(nxp, nyp, nzp, 3), stat=ierr)
+
+     allocate(xsrc(nb, nxp), stat=ierr)
+     allocate(ysrc(nb, nyp), stat=ierr)
+     allocate(zsrc(nb, nzp), stat=ierr)
+
+     allocate(xdst(nb, nxp), stat=ierr)
+     allocate(ydst(nb, nyp), stat=ierr)
+     allocate(zdst(nb, nzp), stat=ierr)
+
+     end subroutine m_calculate_init
+
+
+     subroutine m_calculate_finalize
+
+     deallocate(work)
+
+     deallocate(xsrc)
+     deallocate(ysrc)
+     deallocate(zsrc)
+
+     deallocate(xdst)
+     deallocate(ydst)
+     deallocate(zdst)
+
+     end subroutine m_calculate_finalize
+
+
+     subroutine ddx(src, dst)
+        
+        real*8, dimension(nxp,nyp,nzp) :: src, dst
+
+        integer :: i, j ,k
+
+
+        do k = 1,nzp
+        do j = 1,nyp,nb
+
+        call tp2(xsrc, src(:,j:j+nb-1,k), nb, nxp)
+
+        call dfnonp(nxp, hxp, xsrc, xdst, nb, 1)
+
+        call tp2(dst(:,j:j+nb-1,k), xdst, nxp, nb)
+
+        end do
+        end do
+
+     end subroutine ddx
+
+     subroutine tp(a, b, nx)
+       ! a(nb,nx) = transpose(b(nx,nb))
+        
+        integer,intent(in) :: nx
+
+        real*8,intent(out) :: a(nb,nx)
+        real*8,intent(in) :: b(nx,nb)
+
+        call tp2(a, b, nb, nx)
+
+     end subroutine tp
+
+     subroutine tp2 (a, b, n1, n2)
+       ! a = transpose(b)
+   
+         implicit none
+   
+         integer,intent(in) :: n1, n2
+         real*8,intent(out) :: a(n1,n2)
+         real*8,intent(in) :: b(n2,n1)
+         integer :: i,j,ii,jj
+   
+            DO jj=1,n2,nb
+             DO ii=1,n1,nb
+   
+            DO j=jj,jj+nb-1
+             DO i=ii,ii+nb-1
+               a(i,j) = b(j,i)
+             ENDDO
+            ENDDO
+   
+             ENDDO
+            ENDDO
+   
+     end subroutine tp2
+
+end module m_calculate

code/makefile

@@ -19,6 +19,7 @@ compiler = gfortran
 MODULES += \
     Compact.o\
     m_parameters.o\
+    m_calculate.o\
     m_arrays.o\
     m_terms.o\
     post.o