diff --git a/Code_LEGI/data.f90 b/Code_LEGI/data.f90
deleted file mode 100755
index c73bb9768784964d092216b963f5d633f7c696bf..0000000000000000000000000000000000000000
--- a/Code_LEGI/data.f90
+++ /dev/null
@@ -1,605 +0,0 @@
-module data
- use parallel
- use precision
- use parser
- use fileio
- use string
- implicit none
-
-
- integer :: nvar
-
- real(WP) :: L
- real(WP) :: Ut, le, ld, epsilon, mu,diff
- character(len=str_short) :: spectrum
- character(len=str_medium) :: spfilename,spfilename2
-
- integer :: file_counter,file_fourier
-
- real(WP), dimension(:,:,:,:), pointer :: data_store
- real(WP), dimension(:,:,:), pointer :: data_storesc
- real(WP), dimension(:,:,:), pointer :: U
- real(WP), dimension(:,:,:), pointer :: V
- real(WP), dimension(:,:,:), pointer :: W
- real(WP), dimension(:,:,:), pointer :: SC
-
- type MPI_IO_VAR
- real(WP), dimension(:,:,:), pointer :: var
- integer :: view
- end type MPI_IO_VAR
-
- type(MPI_IO_VAR), dimension(:), pointer :: MPI_IO_DATA
-
- integer, dimension(4) :: dims_w
-
-end module data
-
-subroutine data_init
-
- use data
-
- implicit none
-
- integer :: gsizes(4),lsizes(4),var,start(4),ierr,nv_fourier
- integer :: gsizessc(3),lsizessc(3),startsc(3)
- real(WP) :: sch
-
-! call parser_read('Number of points',nx)
-! call parser_read('Number of points for scalar',nxsc)
- print*,'nx,nxsc',nx,nxsc
- call parser_read('Length of domain', L)
- call parser_read('Spectrum form',spectrum)
- call parser_read('Viscosity',mu,1e-02_WP)
- call parser_read('Schmidt number',sch,0.7_WP)
- diff = mu/sch
-
- ny = nx
- nz = nx
- nvar = 3
- nv_fourier = 3
- nysc = nxsc
- nzsc = nxsc
-
- allocate(data_store(ns1,ns2,ns3,nvar))
- allocate(data_storesc(ns1sc,ns2sc,ns3sc))
-
- data_store = 0.0_WP
- data_storesc = 0.0_WP
- U => data_store(:,:,:,1); ! names(1) = 'U'
- V => data_store(:,:,:,2); ! names(2) = 'V'
- W => data_store(:,:,:,3); ! names(3) = 'W'
- SC => data_storesc(:,:,:); ! names(4) = 'P'
-
-
- dims_w(1) = nx
- dims_w(2) = ny
- dims_w(3) = nz
- dims_w(4) = 3
-
- allocate(MPI_IO_DATA(dims_w(4)+1))
-
- do var = 1,dims_w(4)
- MPI_IO_DATA(var)%var => data_store(:,:,:,var)
- enddo
- MPI_IO_DATA(4)%var => data_storesc(:,:,:)
-
- gsizes(1) = nx
- gsizes(2) = ny
- gsizes(3) = nz
- gsizes(4) = dims_w(4)
-
- lsizes(1) = ns1
- lsizes(2) = ns2
- lsizes(3) = ns3
- lsizes(4) = 1
-
- start(1) = nxs-1
- start(2) = nys-1
- start(3) = nzs-1
-
-
- do var = 1, dims_w(4)
- start(4) = var -1
- call MPI_TYPE_CREATE_SUBARRAY(4,gsizes,lsizes,start,&
- &MPI_ORDER_FORTRAN,MPI_REAL_WP,MPI_IO_DATA(var)%view,ierr)
- call MPI_TYPE_COMMIT(MPI_IO_DATA(var)%view,ierr)
- end do
-
- gsizessc(1) = nxsc
- gsizessc(2) = nysc
- gsizessc(3) = nzsc
-
- lsizessc(1) = ns1sc
- lsizessc(2) = ns2sc
- lsizessc(3) = ns3sc
-
- startsc(1) = nxssc-1
- startsc(2) = nyssc-1
- startsc(3) = nzssc-1
-
-
- call MPI_TYPE_CREATE_SUBARRAY(3,gsizessc,lsizessc,startsc,&
- &MPI_ORDER_FORTRAN,MPI_REAL_WP,MPI_IO_DATA(4)%view,ierr)
- call MPI_TYPE_COMMIT(MPI_IO_DATA(4)%view,ierr)
-
-
- file_counter = 0
- file_fourier = 0
-end subroutine data_init
-
-subroutine data_write
-
- use parallel
- use data
- implicit none
-
-
- integer :: ifile, ierr, var, data_size
- integer, dimension(MPI_STATUS_SIZE) :: status
- integer(KIND=MPI_OFFSET_KIND) :: disp
- character(len=str_medium) :: filename,buffer
-
- logical :: file_is_there
-
- file_counter = file_counter+1
-
- call parser_read('Data file to write',filename)
- write(buffer,'(I3)') file_counter
- spfilename = trim(adjustl(filename))//'_sp_'//trim(adjustl(buffer))
- spfilename2 = trim(adjustl(filename))//'_sz_'//trim(adjustl(buffer))
- call get_dns_numbers(0)
-
- filename = trim(filename)
- write(buffer,'(I3)') file_counter
- filename = trim(adjustl(filename))//'-'//trim(adjustl(buffer))
-
-
- inquire(file=filename, exist=file_is_there)
- if (file_is_there) call MPI_FILE_DELETE(filename,MPI_INFO_NULL,ierr)
- call MPI_FILE_OPEN(MPI_COMM_WORLD,filename,MPI_MODE_WRONLY+MPI_MODE_CREATE, &
- MPI_INFO_NULL,ifile,ierr)
-
- ! Write header
- if (rank.eq.0) then
- ! Write dimensions
- call MPI_FILE_WRITE(ifile,dims_w,4,MPI_INTEGER,status,ierr)
- end if
-!!$ print*,dims_w
-
-!!$ if (rank.eq.0) then
-!!$ print *,' Computed values before writing ',MPI_IO_DATA(2)%var(1:5,1,3)
-!!$ print *,' data values from datastore ', data_store(nxs:nxs+5,nys,nzs,2)
-!!$ endif
-
- disp = 4*4
- data_size = ns1*ns2*ns3
- do var = 1,dims_w(4)
- call MPI_FILE_SET_VIEW(ifile,disp,MPI_REAL_WP,MPI_IO_DATA(var)%view,&
- &"native",MPI_INFO_NULL,ierr)
- call MPI_FILE_WRITE_ALL(ifile,MPI_IO_DATA(var)%var,data_size,&
- &MPI_REAL_WP,status,ierr)
- enddo
-
- disp = 4_MPI_OFFSET_KIND*4 + 8_MPI_OFFSET_KIND*ns1*ns1*ns1*3
- data_size = ns1sc*ns2sc*ns3sc
- call MPI_FILE_SET_VIEW(ifile,disp,MPI_REAL_WP,MPI_IO_DATA(4)%view,&
- &"native",MPI_INFO_NULL,ierr)
- call MPI_FILE_WRITE_ALL(ifile,MPI_IO_DATA(4)%var,data_size,&
- &MPI_REAL_WP,status,ierr)
-! if(rank.eq.0) print*,' size data write 1 : ',4*4 + 8*ns1*ns1*ns1*3 + 8*nproc*ns1sc*ns2sc*ns3sc
-! if(rank.eq.0) print*,' size data write 2 : ',ns1,nproc,ns1sc,ns2sc,ns3sc
-! if(rank.eq.0) print*,' size data write 3 : ',disp
-
-!!$ if (rank.eq.0) then
-!!$ print *,' test writing ',MPI_IO_DATA(1)%var(1,1,1)
-!!$ print *,' test writing ',MPI_IO_DATA(2)%var(1,1,1)
-!!$ print *,' test writing ',MPI_IO_DATA(3)%var(1,1,1)
-!!$ print *,' test writing ',MPI_IO_DATA(4)%var(1,1,1)
-!!$ endif
-
- call MPI_FILE_CLOSE(ifile,ierr)
-
-end subroutine data_write
-
-
-subroutine tab_write(tab,filename)
-
- use parallel
- use data
- implicit none
-
- real(WP) :: tab(ns1,ns2,ns3)
-
- integer :: ifile, ierr, var, data_size, view1
- integer :: gsize1(4),lsize1(4),start1(4)
- integer, dimension(MPI_STATUS_SIZE) :: status
- integer(KIND=MPI_OFFSET_KIND) :: disp
- character*13 :: filename,buffer
-
- logical :: file_is_there
-
- inquire(file=filename, exist=file_is_there)
- if (file_is_there) call MPI_FILE_DELETE(filename,MPI_INFO_NULL,ierr)
-
- call MPI_FILE_OPEN(MPI_COMM_WORLD,filename,MPI_MODE_WRONLY+MPI_MODE_CREATE, &
- MPI_INFO_NULL,ifile,ierr)
- disp = 4*4
- data_size = ns1*ns2*ns3
-
- gsize1(1) = nx
- gsize1(2) = ny
- gsize1(3) = nz
- gsize1(4) = 1
-
- lsize1(1) = ns1
- lsize1(2) = ns2
- lsize1(3) = ns3
- lsize1(4) = 1
-
- start1(1) = nxs-1
- start1(2) = nys-1
- start1(3) = nzs-1
- start1(4) = 0
-
- call MPI_TYPE_CREATE_SUBARRAY(4,gsize1,lsize1,start1,&
- &MPI_ORDER_FORTRAN,MPI_REAL_WP,view1,ierr)
- call MPI_TYPE_COMMIT(view1,ierr)
-
- call MPI_FILE_SET_VIEW(ifile,disp,MPI_REAL_WP,view1,&
- &"native",MPI_INFO_NULL,ierr)
-
- call MPI_FILE_WRITE_ALL(ifile,tab,data_size,&
- &MPI_REAL_WP,status,ierr)
-
-
- !if(rank.eq.0) print*,'1',' 1',' 1',tab(1,1,1)
- !if(rank.eq.0) print*,'1',' 1',' 32',tab(1,1,32)
- !if(rank.eq.7) print*,'1',' 1',' 256',tab(1,1,32)
- !if(rank.eq.7) print*,'1',' 128',' 256',tab(1,128,32)
-
- call MPI_FILE_CLOSE(ifile,ierr)
-
-end subroutine tab_write
-
-subroutine tab_write_ne(tab,filename,ns1ne,ns2ne,ns3ne)
-
- use parallel
- use data
- implicit none
-
-
- integer :: ns1ne,ns2ne,ns3ne
- real(WP) :: tab(ns1ne,ns2ne,ns3ne)
-
- integer :: ifile, ierr, var, data_size, view1
- integer :: gsize1(4),lsize1(4),start1(4)
- integer, dimension(MPI_STATUS_SIZE) :: status
- integer(KIND=MPI_OFFSET_KIND) :: disp
- character*13 :: filename,buffer
-
- logical :: file_is_there
-
- inquire(file=filename, exist=file_is_there)
- if (file_is_there) call MPI_FILE_DELETE(filename,MPI_INFO_NULL,ierr)
-
- call MPI_FILE_OPEN(MPI_COMM_WORLD,filename,MPI_MODE_WRONLY+MPI_MODE_CREATE, &
- MPI_INFO_NULL,ifile,ierr)
- disp = 4*4
- data_size = ns1ne*ns2ne*ns3ne
-
- gsize1(1) = ns1ne
- gsize1(2) = ns1ne
- gsize1(3) = ns1ne
- gsize1(4) = 1
-
- lsize1(1) = ns1ne
- lsize1(2) = ns2ne
- lsize1(3) = ns3ne
- lsize1(4) = 1
-
- start1(1) = 0
- start1(2) = 0
- start1(3) = (rank)*ns3ne
- start1(4) = 0
-
- call MPI_TYPE_CREATE_SUBARRAY(4,gsize1,lsize1,start1,&
- &MPI_ORDER_FORTRAN,MPI_REAL_WP,view1,ierr)
- call MPI_TYPE_COMMIT(view1,ierr)
-
- call MPI_FILE_SET_VIEW(ifile,disp,MPI_REAL_WP,view1,&
- &"native",MPI_INFO_NULL,ierr)
-
- call MPI_FILE_WRITE_ALL(ifile,tab,data_size,&
- &MPI_REAL_WP,status,ierr)
-
-
- !if(rank.eq.0) print*,'1',' 1',' 1',tab(1,1,1)
- !if(rank.eq.0) print*,'1',' 1',' 32',tab(1,1,32)
- !if(rank.eq.7) print*,'1',' 1',' 256',tab(1,1,32)
- !if(rank.eq.7) print*,'1',' 128',' 256',tab(1,128,32)
-
- call MPI_FILE_CLOSE(ifile,ierr)
-
-end subroutine tab_write_ne
-
-
-
-subroutine data_read
-
- use parallel
- use data
- implicit none
-
-
- integer :: ifile, ierr, var, data_size
- integer, dimension(MPI_STATUS_SIZE) :: status
- integer(KIND=MPI_OFFSET_KIND) :: disp
- character(len=str_medium) :: filename,buffer
-
- logical :: file_is_there
-
-
-
- call parser_read('Data file to read',filename)
- filename = trim(filename)
- call MPI_FILE_OPEN(MPI_COMM_WORLD,filename,MPI_MODE_RDONLY, &
- MPI_INFO_NULL,ifile,ierr)
-
- ! Write header
- if (rank.eq.0) then
- ! Write dimensions
- call MPI_FILE_READ(ifile,dims_w,4,MPI_INTEGER,status,ierr)
- end if
-
-!!$ if (rank.eq.0) then
-!!$ print *,' Computed values before writing ',MPI_IO_DATA(2)%var(1:5,1,3)
-!!$ print *,' data values from datastore ', data_store(nxs:nxs+5,nys,nzs,2)
-!!$ endif
-
-
-
- disp = 4*4
- data_size = ns1*ns2*ns3
- do var = 1,dims_w(4)
- call MPI_FILE_SET_VIEW(ifile,disp,MPI_REAL_WP,MPI_IO_DATA(var)%view,&
- &"native",MPI_INFO_NULL,ierr)
- call MPI_FILE_READ_ALL(ifile,MPI_IO_DATA(var)%var,data_size,&
- &MPI_REAL_WP,status,ierr)
- enddo
-
-
- disp = 4_MPI_OFFSET_KIND*4 + 8_MPI_OFFSET_KIND*ns1*ns1*ns1*3
- data_size = ns1sc*ns2sc*ns3sc
-
-
- call MPI_FILE_SET_VIEW(ifile,disp,MPI_REAL_WP,MPI_IO_DATA(4)%view,&
- &"native",MPI_INFO_NULL,ierr)
-
-
- call MPI_FILE_READ_ALL(ifile,MPI_IO_DATA(4)%var,data_size,&
- &MPI_REAL_WP,status,ierr)
-
-
- call MPI_FILE_CLOSE(ifile,ierr)
-
-
-end subroutine data_read
-
-
-subroutine data_filter_sc
-
- use parallel
- use data
-
- implicit none
-
- integer :: nx2,ny2,nz2
- integer :: ns1f,ns2f,ns3f
- integer :: i,j,k,jl
- integer :: nk2, fnys2,fnye2,nkk
-
- real(WP) :: dk2, pi,kk,grms,buf, xx
-
- real(WP), dimension(:,:,:), pointer :: tab
- real(WP), dimension(:,:,:), pointer :: SCF, UF, VF, WF
-
- integer :: gsizes(4),lsizes(4),var,start(4),ierr,nv_fourier,ifilter
- integer :: gsizessc(3),lsizessc(3),startsc(3)
-
- call parser_read('final number of points',nx2)
- call parser_read('filter',ifilter,0)
-
- ny2 = nx2
- nz2 = nx2
-
- ns1f = nx2
- ns2f = nx2
- ns3f = nx2/nproc
-
- ! -- filtering operation >> UF, VF, WF, SCF
- allocate(SCF(ns1f,ns2f,ns3f))
- allocate(UF(ns1,ns2,ns3))
- allocate(VF(ns1,ns2,ns3))
- allocate(WF(ns1,ns2,ns3))
-
- !-- -- -- compute the fourier coefficient
- pi = acos(-1.0_WP)
- dk2 = 2.0_WP*pi/L
-
- nk2 = nx2/2+1
- nkk = nxsc/2+1
-
- !-- -- -- SPECTRAL SPACE : SC_nx -> SCF_nx2
-
- allocate(tab(ns1sc,ns2sc,ns3sc))
- tab=SC**2
- buf=0.
- do k=1,ns3sc
- do j=1,ns2sc
- do i=1,ns1sc
- buf=buf+tab(i,j,k)
- enddo
- enddo
- enddo
- call MPI_ALLREDUCE(buf,grms,1,MPI_REAL_WP,MPI_SUM, &
- MPI_COMM_WORLD,ierr)
- if (rank.eq.0) print*," U rms =",grms/(2.0*ns1sc**3)
- deallocate(tab)
-
-if (nk2.le.nkk) then
-
-! do i = 1, ns1sc
-! xx = (i-1)*L/(ns1sc-1)
-! SC(i,:,:) = sin(xx)
-! print*,xx,SC(i,1,1)
-! end do
-
- call discretisation3(SC,SCF,ns1sc,ns2sc,ns3sc,ns1f,ns2f,ns3f)
-
- UF = U
- VF = V
- WF = W
- call barrier
- if (rank.eq.0) print*,'SC done'
-
-! do i = 1, ns1f
-! xx = (i-1)*L/(ns1f-1)
-! print*,xx,SCF(i,2,2)
-! end do
-
-else
-
- call discretisation2(SC,SCF,ns1sc,ns2sc,ns3sc,ns1f,ns2f,ns3f)
- UF = U
- VF = V
- WF = W
-
-end if
-
- ns1sc = ns1f
- ns2sc = ns2f
- ns3sc = ns3f
-
- allocate(tab(ns1sc,ns2sc,ns3sc))
- tab=SCF**2
- buf=0.
- do k=1,ns3sc
- do j=1,ns2sc
- do i=1,ns1sc
- buf=buf+tab(i,j,k)
- enddo
- enddo
- enddo
- call MPI_ALLREDUCE(buf,grms,1,MPI_REAL_WP,MPI_SUM, &
- MPI_COMM_WORLD,ierr)
- print*," U rms =",grms/(2.0*ns1sc**3.),ns1sc,ns1f
- deallocate(tab)
-
-!! do i = 1, ns1sc
-!! do j = 1, ns2sc
-!! do k = 1, ns3sc
-!! SCF(i,j,k) = 100*i + 10*j + k
-!! print*,'SCF',i,j,k,SCF(i,j,k)
-!! end do
-!! end do
-!! end do
-
-
- ! -- end filtering operation
-
- deallocate(data_storesc)
- deallocate(data_store)
-
- nxsc = nx2
- nysc = ny2
- nzsc = nz2
-
- nxssc = 1
- nxesc = nxsc
- nyssc = 1
- nyesc = nysc
- nzssc = 1 +(rank)*ns3sc
- nzesc = (rank+1)*ns3sc
-
- allocate(data_store(ns1,ns2,ns3,nvar))
- allocate(data_storesc(ns1sc,ns2sc,ns3sc))
-
- data_store = 0.0_WP
- data_storesc = 0.0_WP
- U => data_store(:,:,:,1); ! names(1) = 'U'
- V => data_store(:,:,:,2); ! names(2) = 'V'
- W => data_store(:,:,:,3); ! names(3) = 'W'
- SC => data_storesc(:,:,:); ! names(4) = 'P'
-
-
- dims_w(1) = nx
- dims_w(2) = ny
- dims_w(3) = nz
- dims_w(4) = 3
-
- deallocate(MPI_IO_DATA)
- allocate(MPI_IO_DATA(dims_w(4)+1))
-
- do var = 1,dims_w(4)
- MPI_IO_DATA(var)%var => data_store(:,:,:,var)
- enddo
- MPI_IO_DATA(4)%var => data_storesc(:,:,:)
-
- gsizes(1) = nx
- gsizes(2) = ny
- gsizes(3) = nz
- gsizes(4) = dims_w(4)
-
- lsizes(1) = ns1
- lsizes(2) = ns2
- lsizes(3) = ns3
- lsizes(4) = 1
-
- start(1) = nxs-1
- start(2) = nys-1
- start(3) = nzs-1
-
-
- do var = 1, dims_w(4)
- start(4) = var -1
- call MPI_TYPE_CREATE_SUBARRAY(4,gsizes,lsizes,start,&
- &MPI_ORDER_FORTRAN,MPI_REAL_WP,MPI_IO_DATA(var)%view,ierr)
- call MPI_TYPE_COMMIT(MPI_IO_DATA(var)%view,ierr)
- end do
-
- gsizessc(1) = nxsc
- gsizessc(2) = nysc
- gsizessc(3) = nzsc
-
- lsizessc(1) = ns1sc
- lsizessc(2) = ns2sc
- lsizessc(3) = ns3sc
-
- startsc(1) = nxssc-1
- startsc(2) = nyssc-1
- startsc(3) = nzssc-1
-
-
- call MPI_TYPE_CREATE_SUBARRAY(3,gsizessc,lsizessc,startsc,&
- &MPI_ORDER_FORTRAN,MPI_REAL_WP,MPI_IO_DATA(4)%view,ierr)
- call MPI_TYPE_COMMIT(MPI_IO_DATA(4)%view,ierr)
-
- SC = SCF
- U = UF
- V = VF
- W = WF
- deallocate(SCF)
- deallocate(UF)
- deallocate(VF)
- deallocate(WF)
-!! do i = 1, ns1sc
-!! do j = 1, ns2sc
-!! do k = 1, ns3sc
-!! print*,'SC',i,j,k,SC(i,j,k)
-!! end do
-!! end do
-!! end do
-
- file_counter = 0
-end subroutine data_filter_sc
-
diff --git a/Code_LEGI/discretisation2.f90 b/Code_LEGI/discretisation2.f90
deleted file mode 100755
index 4b62410cd9fe4dee34150ec3b2c1aa856edb860d..0000000000000000000000000000000000000000
--- a/Code_LEGI/discretisation2.f90
+++ /dev/null
@@ -1,184 +0,0 @@
-subroutine discretisation2(U1,U2,ns1old,ns2old,ns3old,ns1new,ns2new,ns3new)
-
- use solver
- use parallel
-! use data
-
- implicit none
-
- integer :: ns1old,ns2old,ns3old,ns1new,ns2new,ns3new
- integer :: fns1old,fns2old,fns3old,fns1new,fns2new,fns3new
- real(WP) :: U1(ns1old,ns2old,ns3old)
- real(WP) :: U2(ns1new,ns2new,ns3new)
- complex(WP), dimension(:,:,:), allocatable :: U1k, U2k, U1kscloc, U1ksc, tabbuf
- integer :: sizemess, tag, ierr, status(MPI_STATUS_SIZE), i, j, k
- integer :: yeloc, ysloc, yelocsc, yslocsc, rank2send1, rank2send2, fs1, fe1, fs2, fe2, fnysrank, fnyerank, cptrank
-
- fns1old = ns1old/2+1
- fns2old = ns1old/nproc
- fns3old = ns1old
-
- fns1new = ns1new/2+1
- fns2new = ns1new/nproc
- fns3new = ns1new
-
- allocate(U1k(fns1old,fns2old,fns3old))
- call ftran_wrap(U1,U1k,ns1old,ns2old,ns3old,fns1old,fns2old,fns3old)
- U1k = U1k/real(ns1old**3.0,WP)
-
- allocate(U1ksc(fns1new,fns2new,fns3new))
- U1ksc = 0.
-
- if (nproc.ne.1) then
-
- allocate(U1kscloc(fns1old,fns2new,fns3old))
- U1kscloc = 0.
-
- ! Communication
- do cptrank = 0, nproc-1
-
- fnysrank = 1 + cptrank*fns2old
- fnyerank = (1+cptrank)*fns2old
-
- ! Envoi
- if (fnyerank.le.ns1old/2+1) then ! envoi j de 1 Ã <nk
- rank2send1 = floor(real(fnyerank-1)/real(fns2new))
- rank2send2 = floor(real(fnysrank-1)/real(fns2new))
- fs1 = max(fnysrank,1+rank2send1*fns2new)
- fe1 = min(fnyerank,(1+rank2send1)*fns2new)
- fs2 = max(fnysrank,1+rank2send2*fns2new)
- fe2 = min(fnyerank,(1+rank2send2)*fns2new)
- else if(fnysrank.gt.ns1old/2+1) then ! envoi j de >nk à nx
- rank2send1 = floor(real(fnyerank+ns1new-ns1old-1)/real(fns2new))
- rank2send2 = floor(real(fnysrank+ns1new-ns1old-1)/real(fns2new))
- fs1 = max(fnysrank,1+rank2send1*fns2new+ns1old-ns1new)
- fe1 = min(fnyerank,(1+rank2send1)*fns2new+ns1old-ns1new)
- fs2 = max(fnysrank,1+rank2send2*fns2new+ns1old-ns1new)
- fe2 = min(fnyerank,(1+rank2send2)*fns2new+ns1old-ns1new)
- else if(fnysrank.le.ns1old/2+1.and.fnyerank.gt.ns1old/2+1) then
- rank2send1 = floor(real(fnyerank+ns1new-ns1old-1)/real(fns2new))
- rank2send2 = floor(real(fnysrank-1)/real(fns2new))
- fs1 = max(ns1old/2+2,1+rank2send1*fns2new+ns1old-ns1new)
- fe1 = min(fnyerank,(1+rank2send1)*fns2new+ns1old-ns1new)
- fs2 = max(fnysrank,1+rank2send2*fns2new)
- fe2 = min(ns1old/2+1,(1+rank2send2)*fns2new)
- end if
- if (rank.eq.cptrank) then
- ysloc = fs1 - rank * fns2old
- yeloc = fe1 - rank * fns2old
- if(cptrank.ne.rank2send1) then
- sizemess = fns1old*fns3old*(yeloc-ysloc+1)
- allocate(tabbuf(fns1old,yeloc-ysloc+1,fns3old))
- tabbuf(:,:,:) = U1k(:,ysloc:yeloc,:)
- tag = fs1+1000*fe1+1000000*1
- call MPI_SEND(tabbuf,sizemess,MPI_COMPLEX_WP,rank2send1,tag,MPI_COMM_WORLD,ierr)
- deallocate(tabbuf)
- else
- if (fnye.le.ns1old/2+1) then
- yslocsc = fs1 - rank * fns2new
- yelocsc = fe1 - rank * fns2new
- else
- yslocsc = fs1 - rank * fns2new - ns1old + ns1new
- yelocsc = fe1 - rank * fns2new - ns1old + ns1new
- end if
- U1kscloc(:,yslocsc:yelocsc,:) = U1k(:,ysloc:yeloc,:)
- end if
- if (rank2send1.ne.rank2send2) then
- ysloc = fs2 - rank * fns2old
- yeloc = fe2 - rank * fns2old
- if (cptrank.ne.rank2send2) then
- sizemess = fns1old*fns3old*(yeloc-ysloc+1)
- allocate(tabbuf(fns1old,yeloc-ysloc+1,fns3old))
- tabbuf(:,:,:) = U1k(:,ysloc:yeloc,:)
- tag = fs2+1000*fe2+1000000*1
- call MPI_SEND(tabbuf,sizemess,MPI_COMPLEX_WP,rank2send2,tag,MPI_COMM_WORLD,ierr)
- deallocate(tabbuf)
- else
- if (fnye.le.ns1old/2+1) then
- yslocsc = fs2 - rank * fns2new
- yelocsc = fe2 - rank * fns2new
- else
- yslocsc = fs2 - rank * fns2new - ns1old + ns1new
- yelocsc = fe2 - rank * fns2new - ns1old + ns1new
- end if
- U1kscloc(:,yslocsc:yelocsc,:) = U1k(:,ysloc:yeloc,:)
- end if
- end if
- else if (rank.eq.rank2send1.and.rank2send1.ne.cptrank) then
- fnysrank = 1 + rank*fns2new
- fnyerank = (1+rank)*fns2new
- if (fnyerank.gt.(ns1new-ns1old+ns1old/2+1)) then
- ysloc = fs1 - rank * fns2new + ns1new - ns1old
- yeloc = fe1 - rank * fns2new + ns1new - ns1old
- else
- ysloc = fs1 - rank * fns2new
- yeloc = fe1 - rank * fns2new
- end if
- sizemess = fns1old*fns3old*(yeloc-ysloc+1)
- allocate(tabbuf(fns1old,yeloc-ysloc+1,fns3old))
- tag = fs1+1000*fe1+1000000*1
- call MPI_RECV(tabbuf,sizemess,MPI_COMPLEX_WP,cptrank,tag,MPI_COMM_WORLD,status,ierr)
- U1kscloc(:,ysloc:yeloc,:) = tabbuf(:,:,:)
- deallocate(tabbuf)
- else if (rank.eq.rank2send2.and.rank2send2.ne.cptrank.and.rank2send2.ne.rank2send1) then
- fnysrank = 1 + rank*fns2new
- fnyerank = (1+rank)*fns2new
- if (fnyerank.gt.(ns1new-ns1old+ns1old/2+1)) then
- ysloc = fs2 - rank * fns2new + ns1new - ns1old
- yeloc = fe2 - rank * fns2new + ns1new - ns1old
- else
- ysloc = fs2 - rank * fns2new
- yeloc = fe2 - rank * fns2new
- end if
- sizemess = fns1old*fns3old*(yeloc-ysloc+1)
- allocate(tabbuf(fns1old,yeloc-ysloc+1,fns3old))
- tag = fs2+1000*fe2+1000000*1
- call MPI_RECV(tabbuf,sizemess,MPI_COMPLEX_WP,cptrank,tag,MPI_COMM_WORLD,status,ierr)
- U1kscloc(:,ysloc:yeloc,:) = tabbuf(:,:,:)
- deallocate(tabbuf)
- end if
- end do
- call MPI_BARRIER(MPI_COMM_WORLD,ierr)
-
-
- do i = 1 , ns1old/2 + 1
- do k = 1 , ns1old/2 + 1
- U1ksc(i,:,k) = U1kscloc(i,:,k)
- end do
- do k = ns1new-ns1old/2+2 , ns1new
- U1ksc(i,:,k) = U1kscloc(i,:,ns1old-ns1new+k)
- end do
- end do
- deallocate(U1kscloc)
-
- else
-
- do i = 1 , ns1old/2 + 1
- do j = 1 , ns1old/2 + 1
- do k = 1 , ns1old/2 + 1
- U1ksc(i,j,k) = U1k(i,j,k)
- end do
- do k = ns1new-ns1old/2+2 , ns1new
- U1ksc(i,j,k) = U1k(i,j,ns1old-ns1new+k)
- end do
- end do
- do j = ns1new-ns1old/2+2 , ns1new
- do k = 1 , ns1old/2 + 1
- U1ksc(i,j,k) = U1k(i,ns1old-ns1new+j,k)
- end do
- do k = ns1new-ns1old/2+2 , ns1new
- U1ksc(i,j,k) = U1k(i,ns1old-ns1new+j,ns1old-ns1new+k)
- end do
- end do
- end do
-
- end if
-
- call btran_wrap(U1ksc,U2,ns1new,ns2new,ns3new,fns1new,fns2new,fns3new)
-
- deallocate(U1ksc)
- deallocate(U1k)
-
-end subroutine discretisation2
-
-
diff --git a/Code_LEGI/discretisation3.f90 b/Code_LEGI/discretisation3.f90
deleted file mode 100755
index 930dbc3b3cd4b584c2bba17242c455e91e468f20..0000000000000000000000000000000000000000
--- a/Code_LEGI/discretisation3.f90
+++ /dev/null
@@ -1,222 +0,0 @@
-subroutine discretisation3(U1,U2,ns1old,ns2old,ns3old,ns1new,ns2new,ns3new)
-
- ! fns1new < fns1old
-
- use solver
- use parallel
-
- implicit none
-
- integer :: ns1old,ns2old,ns3old,ns1new,ns2new,ns3new
- integer :: fns1old,fns2old,fns3old,fns1new,fns2new,fns3new,fs,fe,fsold,feold,yminnew,ymaxnew,yminold,ymaxold
- real(WP) :: U1(ns1old,ns2old,ns3old)
- real(WP) :: U2(ns1new,ns2new,ns3new)
- complex(WP), dimension(:,:,:), allocatable :: U1k, U2k, U1kscloc, U1ksc, tabbuf
- integer :: sizemess, tag, ierr, status(MPI_STATUS_SIZE), i, j, k, itest
- integer :: yeloc, ysloc, yelocsc, yslocsc, rank2send1, rank2send2, fs1, fe1, fs2, fe2, fnysrank, fnyerank, cptrank, rank2send
-
-! print*,ns1old,ns2old,ns3old,ns1new,ns2new,ns3new
-
- fns1old = ns1old/2+1
- fns2old = ns1old/nproc
- fns3old = ns1old
-
- fns1new = ns1new/2+1
- fns2new = ns1new/nproc
- fns3new = ns1new
-
- allocate(U1k(fns1old,fns2old,fns3old))
- call ftran_wrap(U1,U1k,ns1old,ns2old,ns3old,fns1old,fns2old,fns3old)
- U1k = U1k/real(ns1old**3.0,WP)
-
- allocate(U1ksc(fns1new,fns2new,fns3new))
- U1ksc = 0.
-
- if (nproc.ne.1) then
-
- allocate(U1kscloc(fns1old,fns2new,fns3old))
- U1kscloc = 0.
-
- ! Communication
- do cptrank = 0, nproc-1
-
- fnysrank = 1 + cptrank*fns2new
- fnyerank = (1+cptrank)*fns2new
-
- ! Envoi
- if (fnyerank.le.ns1new/2+1) then ! envoi j de 1 Ã <nk
-
- rank2send1 = floor(real(fnyerank-1)/real(fns2old))
- rank2send2 = floor(real(fnysrank-1)/real(fns2old))
- fs1 = max(fnysrank,1+rank2send1*fns2old)
- fe1 = min(fnyerank,(1+rank2send1)*fns2old)
- fs2 = max(fnysrank,1+rank2send2*fns2old)
- fe2 = min(fnyerank,(1+rank2send2)*fns2old)
-
- else if(fnysrank.gt.ns1new/2+1) then ! envoi j de >nk à nx
-
- rank2send1 = floor(real(fnyerank+ns1old-ns1new-1)/real(fns2old))
- rank2send2 = floor(real(fnysrank+ns1old-ns1new-1)/real(fns2old))
- fs1 = max(fnysrank,1+rank2send1*fns2old+ns1new-ns1old)
- fe1 = min(fnyerank,(1+rank2send1)*fns2old+ns1new-ns1old)
- fs2 = max(fnysrank,1+rank2send2*fns2old+ns1new-ns1old)
- fe2 = min(fnyerank,(1+rank2send2)*fns2old+ns1new-ns1old)
-
- else if(fnysrank.le.ns1new/2+1.and.fnyerank.gt.ns1new/2+1) then
-
- rank2send1 = floor(real(fnyerank+ns1old-ns1new-1)/real(fns2old))
- rank2send2 = floor(real(fnysrank-1)/real(fns2old))
- fs1 = max(ns1new/2+2,1+rank2send1*fns2old+ns1new-ns1old)
- fe1 = min(fnyerank,(1+rank2send1)*fns2old+ns1new-ns1old)
- fs2 = max(fnysrank,1+rank2send2*fns2old)
- fe2 = min(ns1new/2+1,(1+rank2send2)*fns2old)
-
- end if
-
- ! ENVOIE
- if (rank.eq.rank2send1.and.rank2send1.ne.cptrank) then
-
- fnysrank = 1 + rank*fns2old
- fnyerank = (1+rank)*fns2old
-
- if (fnyerank.gt.(ns1old-ns1new+ns1new/2+1)) then
- ysloc = fs1 - rank * fns2old + ns1old - ns1new
- yeloc = fe1 - rank * fns2old + ns1old - ns1new
- else
- ysloc = fs1 - rank * fns2old
- yeloc = fe1 - rank * fns2old
- end if
-
- sizemess = fns1old*fns3old*(yeloc-ysloc+1)
- allocate(tabbuf(fns1old,yeloc-ysloc+1,fns3old))
- tag = fs1+1000*fe1+1000000*1
- tabbuf(:,:,:) = U1k(:,ysloc:yeloc,:)
- call MPI_SEND(tabbuf,sizemess,MPI_COMPLEX_WP,cptrank,tag,MPI_COMM_WORLD,ierr)
- deallocate(tabbuf)
-
- else if (rank.eq.rank2send2.and.rank2send2.ne.cptrank.and.rank2send2.ne.rank2send1) then
-
- fnysrank = 1 + rank*fns2old
- fnyerank = (1+rank)*fns2old
-
- if (fnyerank.gt.(ns1old-ns1new+ns1new/2+1)) then
- ysloc = fs2 - rank * fns2old + ns1old - ns1new
- yeloc = fe2 - rank * fns2old + ns1old - ns1new
- else
- ysloc = fs2 - rank * fns2old
- yeloc = fe2 - rank * fns2old
- end if
-
- sizemess = fns1old*fns3old*(yeloc-ysloc+1)
- allocate(tabbuf(fns1old,yeloc-ysloc+1,fns3old))
- tag = fs2+1000*fe2+1000000*1
- tabbuf(:,:,:) = U1k(:,ysloc:yeloc,:)
- call MPI_SEND(tabbuf,sizemess,MPI_COMPLEX_WP,cptrank,tag,MPI_COMM_WORLD,ierr)
- deallocate(tabbuf)
-
- ! RECEPTION
- else if (rank.eq.cptrank) then
-
- ysloc = fs1 - rank * fns2new
- yeloc = fe1 - rank * fns2new
-
- if(cptrank.ne.rank2send1) then
-
- sizemess = fns1old*fns3old*(yeloc-ysloc+1)
- allocate(tabbuf(fns1old,yeloc-ysloc+1,fns3old))
- tag = fs1+1000*fe1+1000000*1
- call MPI_RECV(tabbuf,sizemess,MPI_COMPLEX_WP,rank2send1,tag,MPI_COMM_WORLD,status,ierr)
- U1kscloc(:,ysloc:yeloc,:) = tabbuf(:,:,:)
- deallocate(tabbuf)
-
- else
-
- if (fnyerank.le.ns1new/2+1) then
- yslocsc = fs1 - rank * fns2old
- yelocsc = fe1 - rank * fns2old
- else
- yslocsc = fs1 - rank * fns2old - ns1new + ns1old
- yelocsc = fe1 - rank * fns2old - ns1new + ns1old
- end if
-
- U1kscloc(:,ysloc:yeloc,:) = U1k(:,yslocsc:yelocsc,:)
-
- end if
-
- if (rank2send1.ne.rank2send2) then
-
- ysloc = fs2 - rank * fns2new
- yeloc = fe2 - rank * fns2new
-
- if (cptrank.ne.rank2send2) then
-
- sizemess = fns1old*fns3old*(yeloc-ysloc+1)
- allocate(tabbuf(fns1old,yeloc-ysloc+1,fns3old))
- tag = fs2+1000*fe2+1000000*1
- call MPI_RECV(tabbuf,sizemess,MPI_COMPLEX_WP,rank2send2,tag,MPI_COMM_WORLD,status,ierr)
- U1kscloc(:,ysloc:yeloc,:) = tabbuf(:,:,:)
- deallocate(tabbuf)
-
- else
-
- if (fnyerank.le.ns1new/2+1) then
- yslocsc = fs2 - rank * fns2old
- yelocsc = fe2 - rank * fns2old
- else
- yslocsc = fs2 - rank * fns2old - ns1new + ns1old
- yelocsc = fe2 - rank * fns2old - ns1new + ns1old
- end if
-
- U1kscloc(:,ysloc:yeloc,:) = U1k(:,yslocsc:yelocsc,:)
-
- end if
-
- end if
-
- end if
-
- end do
- call MPI_BARRIER(MPI_COMM_WORLD,ierr)
-
-
- do i = 1 , ns1new/2 + 1
- do k = 1 , ns1new/2 + 1
- U1ksc(i,:,k) = U1kscloc(i,:,k)
- end do
- do k = ns1new, ns1new-ns1new/2+2, -1
- U1ksc(i,:,k) = U1kscloc(i,:,ns1old-ns1new+k)
- end do
- end do
- deallocate(U1kscloc)
-
- else
-
- do i = 1 , ns1new/2 + 1
- do j = 1, ns1new/2 + 1
- do k = 1 , ns1new/2 + 1
- U1ksc(i,j,k) = U1k(i,j,k)
- end do
- do k = ns1new, ns1new-ns1new/2+2, -1
- U1ksc(i,j,k) = U1k(i,j,ns1old-ns1new+k)
- end do
- end do
- do j = ns1new, ns1new-ns1new/2+2, -1
- do k = 1 , ns1new/2 + 1
- U1ksc(i,j,k) = U1k(i,ns1old-ns1new+j,k)
- end do
- do k = ns1new, ns1new-ns1new/2+2, -1
- U1ksc(i,j,k) = U1k(i,ns1old-ns1new+j,ns1old-ns1new+k)
- end do
- end do
- end do
-
- end if
-
- call btran_wrap(U1ksc,U2,ns1new,ns2new,ns3new,fns1new,fns2new,fns3new)
-
- deallocate(U1ksc)
- deallocate(U1k)
-
-end subroutine discretisation3
-
-
diff --git a/Code_LEGI/fileio.f90 b/Code_LEGI/fileio.f90
deleted file mode 100755
index 4e695fca3c4c3ddf4ff1e0841e934cd2f549ab53..0000000000000000000000000000000000000000
--- a/Code_LEGI/fileio.f90
+++ /dev/null
@@ -1,59 +0,0 @@
-module fileio
- use precision
- implicit none
-
- ! File index
- integer :: fileindex
- integer, dimension(128) :: iunits
-
-contains
-
- ! ====================== !
- ! File index management: !
- ! - open a file !
- ! - add it to the list !
- ! ====================== !
- integer function iopen()
- implicit none
-
- integer, save :: icall = 1
- integer :: i
-
- if (icall .eq. 1) then
- fileindex = 1
- icall = 0
- end if
- iunits(fileindex) = 0
- do i=1,fileindex
- if (iunits(i) .eq. 0) exit
- end do
- if (i .eq. fileindex) then
- fileindex = fileindex + 1
- if (fileindex .ge. 128) stop "iopen: maximum units number exceeded"
- end if
- iunits(i) = 1
- iopen = i + 10
- return
- end function iopen
-
- ! ======================= !
- ! File index management: !
- ! - close a file !
- ! - remove it from list !
- ! ======================= !
- integer function iclose(iu)
- implicit none
-
- integer :: iu
-
- iu = iu - 10
- if (iu .gt. 0 .and. iu .lt. fileindex) then
- iunits(iu) = 0
- iclose = iu + 10
- else
- iclose = -1
- end if
- return
- end function iclose
-
-end module fileio
diff --git a/Code_LEGI/forcing.f90 b/Code_LEGI/forcing.f90
deleted file mode 100755
index a6f4dad8226d46741351c37952174200d26fc0d2..0000000000000000000000000000000000000000
--- a/Code_LEGI/forcing.f90
+++ /dev/null
@@ -1,173 +0,0 @@
-module forcing
-
- use solver
- use parallel
-
- implicit none
-
- real(WP) :: kf,ka,kb,c
- real(WP) :: A
-
-
-end module forcing
-
-
-subroutine forcing_init
-
- use forcing
- use parser
-
- implicit none
-
- integer :: i,j,k
-
- real(WP) :: kk
- real(WP) :: force_sum,force_spectrum
- real(WP) :: P
- real(WP) :: keta
- real(WP) :: eta
- real(WP) :: pi
- real(WP) :: Rlm,tke
- real(WP) :: Pf
- real(WP) :: B,nnodes
- real(WP), dimension(:), allocatable :: s,stotal
- integer :: nsize
- integer :: ierr,ik
-
-
- pi = acos(-1.0_WP)
-
- call parser_read('Kmax eta', keta)
- call parser_read('Number of points',nsize)
- call parser_read('R Lambda',Rlm)
- eta = (2.0_WP*keta)/real(nsize,WP)
- P = mu_solver**3.0_WP/eta**4.0_WP
-
- kf = (2.0_WP*pi)/((3.0_WP/20.0_WP*Rlm*Rlm)**0.75_WP*eta)
-! kf = (2.0_WP*pi)/((3.0_WP/20.0_WP*Rlm*Rlm)**0.75_WP*eta)-1.
-
- call parser_read('Power factor',Pf,1.0_WP)
- kf = kf/Pf
-
- if (rank.eq.0) print *,' Forcing wavenumber ', kf
- c = 0.5_WP
- ka = max(1e-10_WP,kf-2._WP) ! max(1e-10_WP,kf-0.5_WP)
- kb = kf+1._WP
-
- force_sum = 0.0_WP
- nnodes = 0.0_WP
-
- allocate(s(ns1+1),stotal(ns1+1))
- s = 0.0_WP
- stotal = 0.0_WP
- do k = 1,fns3
- do j = 1,fns2
- do i = 1,fns1
- kk = sqrt(kx(i)**2.0_WP + ky(j)**2.0_WP + kz(k)**2.0_WP)
- ik = 1+idint(kk + 0.5_WP)
- if (kk.ge.ka.and.kk.le.kb) then
- force_sum = force_sum + force_spectrum(kk,kf,c)/(2.0_WP*pi*kk**2.0_WP)
- s(ik) = s(ik) + force_spectrum(kk,kf,c)/(2.0_WP*pi*kk**2.0_WP)
- nnodes = nnodes + 1.0_WP
- endif
- enddo
- enddo
- enddo
-
- call MPI_ALLREDUCE(force_sum,A,1,MPI_REAL_WP,MPI_SUM,&
- &MPI_COMM_WORLD,ierr)
- call MPI_ALLREDUCE(nnodes,B,1,MPI_REAL_WP,MPI_SUM,&
- &MPI_COMM_WORLD,ierr)
- call MPI_ALLREDUCE(s,stotal,ns1+1,MPI_REAL_WP,MPI_SUM,&
- &MPI_COMM_WORLD,ierr)
-
-
- A = P/A
-
- if (rank.eq.0) print *,' Pre-multiplier for forcing term + nnodes', A,B
-
-
-end subroutine forcing_init
-
-
-subroutine force_compute
-
- use forcing
-
- implicit none
-
- integer :: i,j,k
-
- real(WP) :: rand,pi,kk,force_spectrum
- real(WP) :: phi,psi,theta1,theta2
-
- real(WP) :: e1x,e1y,e1z
- real(WP) :: e2x,e2y,e2z
- real(WP) :: kk2,ga,gb
- complex(WP) :: xi1,xi2,af,bf
- real(WP) :: rxi1,ixi1,rxi2,ixi2
- real(WP) :: num,den,f
-
-
-
- pi = acos(-1.0_WP)
-
-
- do k = 1,fns3
- do j = 1,fns2
- do i = 1,fns1
-
- kk = sqrt(kx(i)**2.0_WP + ky(j)**2.0_WP + kz(k)**2.0_WP)
- kk2 = sqrt(kx(i)**2.0_WP + ky(j)**2.0_WP)
- if (kk2.gt.1e-10_WP.and.kk.gt.1e-10_WP) then
- if (kk.ge.ka.and.kk.le.kb) then
- call random_number(rand)
- phi = pi*rand
- call random_number(rand)
- psi = 2.0_WP*pi*rand
-
- e1x = ky(j)/kk2
- e1y = -kx(i)/kk2
- e1z = 0.0_WP
- e2x = kx(i)*kz(k)/(kk*kk2)
- e2y = ky(j)*kz(k)/(kk*kk2)
- e2z = -(kk2)/kk
- xi1 = Uk(i,j,k)*e1x + Vk(i,j,k)*e1y + Wk(i,j,k)*e1z
- xi2 = Uk(i,j,k)*e2x + Vk(i,j,k)*e2y + Wk(i,j,k)*e2z
- rxi1 = real(0.5_WP*(xi1 + conjg(xi1)),WP)
- rxi2 = real(0.5_WP*(xi2 + conjg(xi2)),WP)
- ixi1 = real(0.5_WP*(-ii)*(xi1 - conjg(xi1)),WP)
- ixi2 = real(0.5_WP*(-ii)*(xi2 - conjg(xi2)),WP)
- ga = sin(2.0_WP*phi)
- gb = cos(2.0_WP*phi)
- num = ga*rxi1 + gb*(sin(psi)*ixi2 + cos(psi)*rxi2)
- den = -ga*ixi1 + gb*(sin(psi)*rxi2 - cos(psi)*ixi2)
- theta1 = atan(num/den)
- theta2 = psi + theta1
- f = A/dt*force_spectrum(kk,kf,c)/(2.0_WP*pi*kk**2.0_WP)
- af = f**0.5_WP*exp(ii*theta1)*ga
- bf = f**0.5_WP*exp(ii*theta2)*gb
- nlx(i,j,k) = nlx(i,j,k) + (af*e1x+bf*e2x)
- nly(i,j,k) = nly(i,j,k) + (af*e1y+bf*e2y)
- nlz(i,j,k) = nlz(i,j,k) + (bf*e2z)
- endif
- endif
- enddo
- enddo
- enddo
-
-
-end subroutine force_compute
-
-function force_spectrum(kk,kf,c)
-
- use precision
- implicit none
-
- real(WP) :: force_spectrum
- real(WP) :: kk,kf,c
-
-
- force_spectrum = exp(-(kk-kf)**2.0_WP/c)
-
-end function force_spectrum
diff --git a/Code_LEGI/init_plane_jet.f90 b/Code_LEGI/init_plane_jet.f90
deleted file mode 100644
index ed065a134e8b3558ad8ba3d4d2b39ded0a690265..0000000000000000000000000000000000000000
--- a/Code_LEGI/init_plane_jet.f90
+++ /dev/null
@@ -1,53 +0,0 @@
-subroutine init_plane_jet
-
- use parallel
- use data
-
- implicit none
-
- real(WP), dimension(:,:,:), pointer :: Ub, Vb, Wb
- real(WP) :: dx, yy, epsil, Htheta, U1, U2, ubm, vbm, wbm
- integer :: j
-
- call hit_init
-
- allocate(Ub(ns1,ns2,ns3))
- allocate(Vb(ns1,ns2,ns3))
- allocate(Wb(ns1,ns2,ns3))
- Ub = U
- Vb = V
- Wb = W
-
- U = 0.0
- V = 0.0
- W = 0.0
-
- dx = L/(real(nx))
-
- call parser_read('H/theta',Htheta)
- call parser_read('Jet velocity',U1)
- call parser_read('Co-flow velocity',U2)
- call parser_read('noise level',epsil)
-
- do j = 1,ns2
- yy = real(j)*dx - L/2.0
- U(:,j,:) = (U1+U2)/2.0 + (U1-U2)/2.0 * tanh( 0.25 * Htheta * (1 - 2*abs(yy) ) )
- SC(:,j,:) = 1.0/2.0 + 1.0/2.0 * tanh( 0.25 * Htheta * (1 - 2*abs(yy) ) )
- if (abs(yy).gt.0.7.or.abs(yy).lt.0.3) then
- Ub(:,j,:) = 0.
- Vb(:,j,:) = 0.
- Wb(:,j,:) = 0.
- end if
- if( rank.eq.0) print*,yy,Ub(1,j,1)
- end do
- ubm = maxval(abs(Ub))
- vbm = maxval(abs(Vb))
- wbm = maxval(abs(Wb))
- Ub = Ub/ubm
- Vb = Vb/vbm
- Wb = Wb/wbm
- U = U + epsil*Ub
- V = V + epsil*Vb
- W = W + epsil*Wb
-
-end subroutine init_plane_jet
diff --git a/Code_LEGI/init_test_case.f90 b/Code_LEGI/init_test_case.f90
deleted file mode 100644
index 056dfccbdc1463bcccf0e3ba62c249e17bd7d3a8..0000000000000000000000000000000000000000
--- a/Code_LEGI/init_test_case.f90
+++ /dev/null
@@ -1,38 +0,0 @@
-subroutine init_test_case
-
- use parallel
- use data
-
- implicit none
-
- real(WP) :: xx, yy, zz, rr
- integer :: i, j, k, direction
-
- call hit_init
-
-! call parser_read('Scalar direction', direction)
-
- do i = 1, ns1sc
- do j = 1, ns2sc
- do k = 1, ns3sc
- xx = i*L/ns1sc - L/2
- yy = j*L/ns2sc - L/2
- zz = k*L/ns3sc - L/2
-! SC(i,j,k) = sqrt(xx**2.0 + yy**2.0 + zz**2.0)
-! SC(i,j,k) = SC(i,j,k)/SC(1,1,1)
-! if (direction.eq.1) SC(i,j,k) = sin(xx)
-! if (direction.eq.2) SC(i,j,k) = sin(yy)
-! if (direction.eq.3) SC(i,j,k) = sin(zz)
- rr = sqrt(xx**2.0 + yy**2.0 + zz**2.0)
- if (rr.gt.L/6) then
- SC(i,j,k) = 0.0
- else
- SC(i,j,k) = 1.0
- end if
- !SC(i,j,k) = rr -L/6.
- end do
- end do
- end do
-
-
-end subroutine init_test_case
diff --git a/Code_LEGI/initscal.f90 b/Code_LEGI/initscal.f90
deleted file mode 100755
index 2450600f1abe63fa98a95b57e6c434f991884f1d..0000000000000000000000000000000000000000
--- a/Code_LEGI/initscal.f90
+++ /dev/null
@@ -1,179 +0,0 @@
-subroutine init_scalar
-
- use parallel
- use transform
- use data
- implicit none
-! include 'fftw3.f'
-
- ! Spectrum computation
- real(WP) :: psr,ps1,ps2
- real(WP) :: ke,kd,ks,dk,ksk0ratio,kc,kcksratio,kk,kx,ky,kz,kk2,kcut
- real(WP) :: alpha,spec_amp,eps,amp_disc,f_phi,sch
- integer :: kl,jl,il,impose
- real(WP) :: e_total,energy_spec,diss_total,ndense
- real(WP), dimension(:,:), pointer :: spect,sg
- real(WP), dimension(:), pointer :: s1,s2
- complex(WP), dimension(:,:,:), pointer :: ak,bk
- real(WP) :: scmean,scmean_global
- ! Other
- integer :: i,j,k,ik,iunit,dim
- real(WP), dimension(:), pointer :: nnodes
- complex(WP) :: ii=(0.0_WP,1.0_WP)
- real(WP) :: rand,pi,spec,kfix
-
- real(WP) :: keta, Rlambda, L11, tke,L_large, dissipation,eta
- real(WP) :: e_spec,d_spec, e_local, d_local, spec_factor
- ! Fourier coefficients
- real(WP) :: umax,vmax,wmax,cos,sin
- complex(WP), dimension(:,:,:), pointer :: Uk,Vk,Wk,scalar
- complex(WP), dimension(:,:,:), pointer :: Cbuf
- real(WP), dimension(:,:,:), pointer :: Rbuf
-
- logical :: flg_inplace
-
- integer :: ierr,gg(3),iforce
- integer,dimension(:,:,:),pointer :: node_index
- integer(KIND=8) :: plan_c2r
-
-!!$ real(WP), dimension(:,:,:), pointer :: A
-!!$ complex(WP), dimension(:,:,:), pointer :: B
-
-
- ! Create pi
- pi = acos(-1.0_WP)
- dk = 2.0_WP*pi/L
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! Input for scalar field
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- call parser_read('ks/ko', ksk0ratio)
- ks = ksk0ratio*dk
-!!! Assume kc/ks to be 2 as in Eswaran and Pope
- kc = 2.0_WP*ks
-
-
- allocate(scalar(fns1,fns2,fns3))
-
- scalar = (0.0_WP,0.0_WP)
-
- do k = 1,fns3
- do j = 1,fns2
- do i = 1,fns1
- il = i + fnxs - 1
- jl = j + fnys - 1
- kl = k + fnzs - 1
-
- kx=real(il-1,WP)*dk
- ky=real(jl-1,WP)*dk
- if (jl.gt.nk) ky=-real(nx-jl+1,WP)*dk
- kz=real(kl-1,WP)*dk
- if (kl.gt.nk) kz=-real(nx-kl+1,WP)*dk
- kk =sqrt(kx**2+ky**2+kz**2)
- kk2=sqrt(kx**2+ky**2)
- if ((ks-dk/2.0_WP.le.kk).and.(kk.le.ks+dk/2.0_WP)) then
- f_phi = 1.0_WP
- else
- f_phi = 0.0_WP
- endif
- call random_number(rand)
- if (kk.lt.1e-10) then
- scalar(i,j,k) = 0.0_WP
- else
- scalar(i,j,k) = sqrt(f_phi/(4.0_WP*pi*kk**2.0_WP))*exp(ii*2.0_WP*pi*rand)
- endif
- enddo
- enddo
- enddo
-
- call btran_wrap(scalar,SC,ns1,ns2,ns3,fns1,fns2,fns3)
-
- do k = 1,ns3
- do j = 1,ns2
- do i = 1,ns1
- if (SC(i,j,k).le.0.0_WP) then
- SC(i,j,k) = 0.0_WP
- else
- SC(i,j,k) = 1.0_WP
- endif
- enddo
- enddo
- enddo
-
- call ftran_wrap(SC,scalar,ns1,ns2,ns3,fns1,fns2,fns3)
-
- kcut = sqrt(2.0_WP)*real(nx,WP)/3.0_WP
- do k = 1,fns3
- do j = 1,fns2
- do i = 1,fns1
- il = i + fnxs - 1
- jl = j + fnys - 1
- kl = k + fnzs - 1
-
- kx=real(il-1,WP)*dk
- ky=real(jl-1,WP)*dk
- if (jl.gt.nk) ky=-real(nx-jl+1,WP)*dk
- kz=real(kl-1,WP)*dk
- if (kl.gt.nk) kz=-real(nx-kl+1,WP)*dk
- kk =sqrt(kx**2+ky**2+kz**2)
- kk2=sqrt(kx**2+ky**2)
-
- if (kk.gt.kcut) scalar(i,j,k) = 0.0_WP
-
- if (kk.le.kc) then
- scalar(i,j,k) = scalar(i,j,k)
- else
- scalar(i,j,k) = scalar(i,j,k)*(kc/kk)**2.0_WP
- endif
- enddo
- enddo
- enddo
-
- call btran_wrap(scalar,SC,ns1,ns2,ns3,fns1,fns2,fns3)
- SC = SC/real(ns1**3.0,WP)
-
-
- call parser_read('Imposing mean gradient',impose,0)
-
-
- if (impose.eq.1) then
- scmean = 0.0_WP
- do k = 1,ns3
- do j = 1,ns2
- do i = 1,ns1
- scmean = scmean + SC(i,j,k)
- enddo
- enddo
- enddo
-
- call MPI_ALLREDUCE(scmean,scmean_global,1,MPI_REAL_WP,MPI_SUM,&
- &MPI_COMM_WORLD,ierr)
-
- scmean = scmean_global/(real(nx,WP)**3.0_WP)
-
-!!!!!!!!!!!! Setting scalar to zero - see if it lies within bounds
- do k = 1,ns3
- do j = 1,ns2
- do i = 1,ns1
- SC(i,j,k) = 0.0_WP
- enddo
- enddo
- enddo
-
- endif
-
-
-
-
- ! Inverse Fourier transform
-
- ! Clean up
- deallocate(scalar)
-
-
-
-end subroutine init_scalar
-
-
-
diff --git a/Code_LEGI/lesmodel.f90 b/Code_LEGI/lesmodel.f90
deleted file mode 100755
index a4098e4253c825d8e7560101b2d85118775ede75..0000000000000000000000000000000000000000
--- a/Code_LEGI/lesmodel.f90
+++ /dev/null
@@ -1,321 +0,0 @@
-subroutine dynsmagmodel
-
- use data
- use parallel
- use solver
-
- integer :: i,j,k
- real(WP) :: deltx,deltt, cst1, cst2
- real(WP) :: Ekf,diss_sgs,diss_mu,tau12,mean_uv, nt
-
- complex(WP), dimension(:,:,:), pointer :: ddxk, ddyk, ddzk
- real(WP), dimension(:,:,:), pointer :: ddx, ddy, ddz
-
- real(WP), dimension(:,:,:), pointer :: S11, S12, S13, S22, S23, S33
- real(WP), dimension(:,:,:), pointer :: L11, L12, L13, L22, L23, L33
- real(WP), dimension(:,:,:), pointer :: M11, M12, M13, M22, M23, M33
- real(WP), dimension(:,:,:), pointer :: T11, T12, T13, T22, T23, T33
- real(WP), dimension(:,:,:), pointer :: R11, R12, R13, R22, R23, R33
- real(WP), dimension(:,:,:), pointer :: V11, V12, V13, V22, V23, V33
- real(WP), dimension(:,:,:), pointer :: uft, vft, wft
- real(WP), dimension(:,:,:), pointer :: dudx, dudy, dudz
- real(WP), dimension(:,:,:), pointer :: dvdx, dvdy, dvdz
- real(WP), dimension(:,:,:), pointer :: dwdx, dwdy, dwdz
- real(WP), dimension(:,:,:), pointer :: normS, normR
- real(WP), dimension(:,:), pointer :: SPEC1, SPEC11
- real(WP), dimension(:), pointer :: coefffy, cst1y, cst2y
-
- deltx = L/(real(nx))
- deltt = 2*deltx
- nt = 2.0
-
- call u_compute
-
- allocate(dudx(ns1,ns2,ns3))
- allocate(dudy(ns1,ns2,ns3))
- allocate(dudz(ns1,ns2,ns3))
- allocate(dvdx(ns1,ns2,ns3))
- allocate(dvdy(ns1,ns2,ns3))
- allocate(dvdz(ns1,ns2,ns3))
- allocate(dwdx(ns1,ns2,ns3))
- allocate(dwdy(ns1,ns2,ns3))
- allocate(dwdz(ns1,ns2,ns3))
- call gradient(U,0,dudx,dudy,dudz)
- call gradient(V,0,dvdx,dvdy,dvdz)
- call gradient(W,0,dwdx,dwdy,dwdz)
- allocate(S11(ns1,ns2,ns3))
- allocate(S12(ns1,ns2,ns3))
- allocate(S13(ns1,ns2,ns3))
- allocate(S22(ns1,ns2,ns3))
- allocate(S23(ns1,ns2,ns3))
- allocate(S33(ns1,ns2,ns3))
- allocate(normS(ns1,ns2,ns3))
- S11 = dudx
- S22 = dvdy
- S33 = dwdz
- S12 = 0.5*(dudy+dvdx)
- S13 = 0.5*(dudz+dwdx)
- S23 = 0.5*(dvdz+dwdy)
- normS = sqrt(2.0*(S11*S11 + S22*S22 + S33*S33 + 2.0*S12*S12 + 2.0*S13*S13 + 2.0*S23*S23))
-
- ! - dyn procedure
- allocate(R11(ns1,ns2,ns3))
- allocate(R12(ns1,ns2,ns3))
- allocate(R13(ns1,ns2,ns3))
- allocate(R22(ns1,ns2,ns3))
- allocate(R23(ns1,ns2,ns3))
- allocate(R33(ns1,ns2,ns3))
- R11 = normS*S11
- R12 = normS*S12
- R13 = normS*S13
- R22 = normS*S22
- R23 = normS*S23
- R33 = normS*S33
- allocate(V11(ns1,ns2,ns3))
- allocate(V12(ns1,ns2,ns3))
- allocate(V13(ns1,ns2,ns3))
- allocate(V22(ns1,ns2,ns3))
- allocate(V23(ns1,ns2,ns3))
- allocate(V33(ns1,ns2,ns3))
- call specboxfilter(R11,V11,nt)
- call specboxfilter(R12,V12,nt)
- call specboxfilter(R13,V13,nt)
- call specboxfilter(R22,V22,nt)
- call specboxfilter(R23,V23,nt)
- call specboxfilter(R33,V33,nt)
- allocate(uft(ns1,ns2,ns3))
- allocate(vft(ns1,ns2,ns3))
- allocate(wft(ns1,ns2,ns3))
- call specboxfilter(U,uft,nt)
- call specboxfilter(V,vft,nt)
- call specboxfilter(W,wft,nt)
- call gradient(uft,0,dudx,dudy,dudz)
- call gradient(vft,0,dvdx,dvdy,dvdz)
- call gradient(wft,0,dwdx,dwdy,dwdz)
- R11 = dudx
- R22 = dvdy
- R33 = dwdz
- R12 = 0.5*(dudy+dvdx)
- R13 = 0.5*(dudz+dwdx)
- R23 = 0.5*(dvdz+dwdy)
- allocate(normR(ns1,ns2,ns3))
- normR = 2*sqrt(R11*R11 + R22*R22 + R33*R33 + 2.0*R12*R12 + 2.0*R13*R13 + 2.0*R23*R23)
- deallocate(dudx)
- deallocate(dudy)
- deallocate(dudz)
- deallocate(dvdx)
- deallocate(dvdy)
- deallocate(dvdz)
- deallocate(dwdx)
- deallocate(dwdy)
- deallocate(dwdz)
- R11 = normR*R11
- R12 = normR*R12
- R13 = normR*R13
- R22 = normR*R22
- R23 = normR*R23
- R33 = normR*R33
- deallocate(normR)
- allocate(M11(ns1,ns2,ns3))
- allocate(M12(ns1,ns2,ns3))
- allocate(M13(ns1,ns2,ns3))
- allocate(M22(ns1,ns2,ns3))
- allocate(M23(ns1,ns2,ns3))
- allocate(M33(ns1,ns2,ns3))
- M11 = deltt**2.*R11 - deltx**2.*V11
- M22 = deltt**2.*R22 - deltx**2.*V22
- M33 = deltt**2.*R33 - deltx**2.*V33
- M12 = deltt**2.*R12 - deltx**2.*V12
- M13 = deltt**2.*R13 - deltx**2.*V13
- M23 = deltt**2.*R23 - deltx**2.*V23
- deallocate(V11)
- deallocate(V22)
- deallocate(V33)
- deallocate(V12)
- deallocate(V13)
- deallocate(V23)
- allocate(L11(ns1,ns2,ns3))
- allocate(L12(ns1,ns2,ns3))
- allocate(L13(ns1,ns2,ns3))
- allocate(L22(ns1,ns2,ns3))
- allocate(L23(ns1,ns2,ns3))
- allocate(L33(ns1,ns2,ns3))
- R11 = U*U
- R22 = V*V
- R33 = W*W
- R12 = U*V
- R13 = U*W
- R23 = V*W
- call specboxfilter(R11,L11,nt)
- call specboxfilter(R12,L12,nt)
- call specboxfilter(R13,L13,nt)
- call specboxfilter(R22,L22,nt)
- call specboxfilter(R23,L23,nt)
- call specboxfilter(R33,L33,nt)
- L11 = L11 - uft*uft
- L22 = L22 - vft*vft
- L33 = L33 - wft*wft
- L12 = L12 - uft*vft
- L13 = L13 - uft*wft
- L23 = L23 - vft*wft
- deallocate(R11)
- deallocate(R22)
- deallocate(R33)
- deallocate(R12)
- deallocate(R13)
- deallocate(R23)
- deallocate(uft)
- deallocate(vft)
- deallocate(wft)
- L11 = L11*M11 + 2.*L12*M12 + 2.*L13*M13 + L22*M22 + 2.*L23*M23 + L33*M33
- M11 = M11*M11 + 2.*M12*M12 + 2.*M13*M13 + M22*M22 + 2.*M23*M23 + M33*M33
- allocate(cst1y(ns2))
- allocate(cst2y(ns2))
- allocate(coefffy(ns2))
- call moyen_y(L11,cst1y)
- call moyen_y(M11,cst2y)
- coefffy = cst1y / cst2y
- deallocate(cst1y)
- deallocate(cst2y)
- deallocate(L11)
- deallocate(L22)
- deallocate(L33)
- deallocate(L12)
- deallocate(L13)
- deallocate(L23)
- deallocate(M11)
- deallocate(M22)
- deallocate(M33)
- deallocate(M12)
- deallocate(M13)
- deallocate(M23)
- allocate(T11(ns1,ns2,ns3))
- allocate(T12(ns1,ns2,ns3))
- allocate(T13(ns1,ns2,ns3))
- allocate(T22(ns1,ns2,ns3))
- allocate(T23(ns1,ns2,ns3))
- allocate(T33(ns1,ns2,ns3))
- do j=1,ns2
- T11(:,j,:) = coefffy(j) * deltx**2.0 * normS(:,j,:) * S11(:,j,:)
- T12(:,j,:) = coefffy(j) * deltx**2.0 * normS(:,j,:) * S12(:,j,:)
- T13(:,j,:) = coefffy(j) * deltx**2.0 * normS(:,j,:) * S13(:,j,:)
- T22(:,j,:) = coefffy(j) * deltx**2.0 * normS(:,j,:) * S22(:,j,:)
- T23(:,j,:) = coefffy(j) * deltx**2.0 * normS(:,j,:) * S23(:,j,:)
- T33(:,j,:) = coefffy(j) * deltx**2.0 * normS(:,j,:) * S33(:,j,:)
- end do
- deallocate(coefffy)
-
- ! postprocessing
- ! Ekf
- call moyen(U**2.+V**2.+W**2.,cst1)
- Ekf = cst1/2
- ! SGS dissipation
- normS = - ( T11*S11 + T22*S22 + T33*S33 + 2.*T12*S12 + 2.*T13*S13 + 2.*T23*S23 )
- call moyen(normS,diss_sgs)
-
- allocate(SPEC1(2,nx+1))
- allocate(SPEC11(2,nx+1))
- SPEC1 = 0.0
- SPEC11 = 0.0
-! call get_spectrum(normS,ns1,ns2,ns3,L,SPEC1,SPEC11)
-! if (rank.eq.0) then
-! open(14,file='spectrum_sgs_diss', form = 'formatted')
-! do i = 1, nx+1
-! if ((SPEC1(1,i).ne.0.0).and.(SPEC1(2,i).ne.0.0)) then
-! write(14,*) SPEC11(1,i), SPEC1(2,i)
-! end if
-! end do
-! end if
- deallocate(SPEC1)
- deallocate(SPEC11)
- ! mu dissipation
- call moyen( ( S11*S11 + S22*S22 + S33*S33 + 2.*S12*S12 + 2.*S13*S13 + 2.*S23*S23 ),diss_mu)
- diss_mu = mu_solver * diss_mu
- ! tau12
- call moyen((T12)**2.,tau12)
- ! <uv>
- call moyen(U*V,mean_uv)
- if (rank.eq.0) then
- write(*,'(A10,10(E12.5,3X))') '',sim_time,Ekf,diss_sgs,diss_mu,tau12,mean_uv
- end if
-
- deallocate(S11)
- deallocate(S22)
- deallocate(S33)
- deallocate(S12)
- deallocate(S13)
- deallocate(S23)
- deallocate(normS)
-
- allocate(ddx(ns1,ns2,ns3))
- allocate(ddy(ns1,ns2,ns3))
- allocate(ddz(ns1,ns2,ns3))
- allocate(ddxk(fns1,fns2,fns3))
- allocate(ddyk(fns1,fns2,fns3))
- allocate(ddzk(fns1,fns2,fns3))
- ! -- x
- ddx = - T11
- ddy = - T12
- ddz = - T13
- call ftran_wrap(ddx,ddxk,ns1,ns2,ns3,fns1,fns2,fns3)
- call ftran_wrap(ddy,ddyk,ns1,ns2,ns3,fns1,fns2,fns3)
- call ftran_wrap(ddz,ddzk,ns1,ns2,ns3,fns1,fns2,fns3)
- ddxk = ddxk/real((ns1**3.0),WP)
- ddyk = ddyk/real((ns1**3.0),WP)
- ddzk = ddzk/real((ns1**3.0),WP)
- do k = 1, fns3
- do j = 1, fns2
- do i = 1, fns1
- nlx(i,j,k) = nlx(i,j,k) - ii*kx(i)*ddxk(i,j,k) - ii*ky(j)*ddyk(i,j,k) - ii*kz(k)*ddzk(i,j,k)
- end do
- end do
- end do
- ! -- y
- ddx = - T12
- ddy = - T22
- ddz = - T23
- call ftran_wrap(ddx,ddxk,ns1,ns2,ns3,fns1,fns2,fns3)
- call ftran_wrap(ddy,ddyk,ns1,ns2,ns3,fns1,fns2,fns3)
- call ftran_wrap(ddz,ddzk,ns1,ns2,ns3,fns1,fns2,fns3)
- ddxk = ddxk/real((ns1**3.0),WP)
- ddyk = ddyk/real((ns1**3.0),WP)
- ddzk = ddzk/real((ns1**3.0),WP)
- do k = 1, fns3
- do j = 1, fns2
- do i = 1, fns1
- nly(i,j,k) = nly(i,j,k) - ii*kx(i)*ddxk(i,j,k) - ii*ky(j)*ddyk(i,j,k) - ii*kz(k)*ddzk(i,j,k)
- end do
- end do
- end do
- ! -- z
- ddx = - T13
- ddy = - T23
- ddz = - T33
- call ftran_wrap(ddx,ddxk,ns1,ns2,ns3,fns1,fns2,fns3)
- call ftran_wrap(ddy,ddyk,ns1,ns2,ns3,fns1,fns2,fns3)
- call ftran_wrap(ddz,ddzk,ns1,ns2,ns3,fns1,fns2,fns3)
- ddxk = ddxk/real((ns1**3.0),WP)
- ddyk = ddyk/real((ns1**3.0),WP)
- ddzk = ddzk/real((ns1**3.0),WP)
- do k = 1, fns3
- do j = 1, fns2
- do i = 1, fns1
- nlz(i,j,k) = nlz(i,j,k) - ii*kx(i)*ddxk(i,j,k) - ii*ky(j)*ddyk(i,j,k) - ii*kz(k)*ddzk(i,j,k)
- end do
- end do
- end do
-
- deallocate(T11)
- deallocate(T22)
- deallocate(T33)
- deallocate(T12)
- deallocate(T13)
- deallocate(T23)
- deallocate(ddxk)
- deallocate(ddyk)
- deallocate(ddzk)
- deallocate(ddx)
- deallocate(ddy)
- deallocate(ddz)
-
-end subroutine dynsmagmodel
diff --git a/Code_LEGI/main.f90 b/Code_LEGI/main.f90
deleted file mode 100755
index c5665ebf0e74f7a80bc151a3f0d917ba4eb58e93..0000000000000000000000000000000000000000
--- a/Code_LEGI/main.f90
+++ /dev/null
@@ -1,111 +0,0 @@
-subroutine main_init
-
- use parallel
- use parser
- use string
- use advec
- implicit none
-
- character(len=str_long) :: sim_name
- integer :: simtype, ipost, iscal
-
- ! Traitement du fichier contenant les paramètres de simulation
- call parser_init
- call parser_parsefile('input')
-
- ! Initialisation
- call mpi_initialize
- call transform_init
- call data_init
-
-
- call parser_read('Simulation name', sim_name) ! Typ d'écoulement choisi
- call parser_read('Simulation type', simtype)
- call parser_read('Re-init scalar', iscal)
- !call parser_read('Particule_order', part_method) ! Méthode numérique utilisée pour advecter le scalaire
-
-
- if (simtype.eq.0) then !!!! Initialize and compute
- if (trim(sim_name).eq.'Taylor Green') then
- call tg_init
- elseif(trim(sim_name).eq.'Isotropic turbulence') then
- call hit_init
- elseif(trim(sim_name).eq.'Plane jet') then
- call init_plane_jet
- elseif(trim(sim_name).eq.'Test case') then
- call init_test_case
- else
- print *,' Unknown Simulation Name'
- stop
- endif
- elseif (simtype.eq.1) then
- call data_read
- if( iscal.eq.1) then
- call init_test_case
- endif
- else
- print *,' Unknown simulation type'
- stop
- endif
-
- call solver_init
-
- call advec_init
-
-! call parser_read('Postprocessing', ipost)
-! if (ipost.eq.1) print*,'not yet implemented'
-
-end subroutine main_init
-
-
-program main
-
- use parallel
- use parser
- use string
- implicit none
- integer :: i,n_iter
- character(len=str_long) :: sim_name
- integer :: ifreq, ipost,itest
-
- call main_init
-
- call parser_read('Postprocessing',ipost)
-
- call parser_read('Simulation iterations',n_iter)
- call parser_read('Simulation name',sim_name)
- call parser_read('Write frequency',ifreq,n_iter)
- if (sim_name.eq.'Isotropic turbulence'.or.sim_name.eq.'Plane jet') call dns_stats
-
-
-
- if (ipost.eq.1) then
- call postprocess
- else if(ipost.eq.2) then
- call data_filter_sc
- call data_write
- stop
- else if(ipost.eq.5) then
- call postprocess5
- stop
- else if(ipost.eq.6) then
- call postprocess6
- stop
- else if(ipost.eq.7) then
- call postprocess7
- stop
- else
- call data_write
- do i = 1,n_iter
- call solver_step
- if (trim(sim_name).eq.'Taylor Green') then
- call tg_stats
- elseif (trim(sim_name).eq.'Isotropic turbulence'.or.sim_name.eq.'Plane jet') then
- call dns_stats
- endif
- if (mod(i,ifreq).eq.0) call data_write
- enddo
-! call postprocess
- end if
-
-end program main
diff --git a/Code_LEGI/mpi_init.f90 b/Code_LEGI/mpi_init.f90
deleted file mode 100755
index fabf5660dee67af3644063293a04822fd7bcb458..0000000000000000000000000000000000000000
--- a/Code_LEGI/mpi_init.f90
+++ /dev/null
@@ -1,185 +0,0 @@
-module parallel
-
- implicit none
- include 'mpif.h'
-
- integer :: nproc, rank
-
- integer :: nx,ny,nz ! Number of mesh for the velocity
- integer :: nxsc,nysc,nzsc ! Number of mesh for the scalar
-
- integer :: ns1,ns2,ns3,nk
- integer :: fns1, fns2, fns3
-
- integer :: ns1sc,ns2sc,ns3sc,nksc
- integer :: fns1sc, fns2sc, fns3sc
-
- integer :: nxs,nxe,nys,nye,nzs,nze
- integer :: fnxs,fnxe,fnys,fnye,fnzs,fnze
-
- integer :: nxssc,nxesc,nyssc,nyesc,nzssc,nzesc
- integer :: fnxssc,fnxesc,fnyssc,fnyesc,fnzssc,fnzesc
-
-
- integer :: ndim
-
- integer :: MPI_REAL_WP
- integer :: MPI_COMPLEX_WP
-
-end module parallel
-
-
-subroutine mpi_initialize
-
- use precision
- use parallel
- use parser
- implicit none
-
- integer :: ierr
- integer :: size_dp
-
-
- call MPI_INIT(ierr)
- call MPI_COMM_SIZE(MPI_COMM_WORLD,nproc,ierr)
- call MPI_COMM_RANK(MPI_COMM_WORLD,rank,ierr)
-
-
-
- call parser_read('Number of points',nx)
- ny = nx
- nz = nx
-
- if (mod(nz,nproc).ne.0) then
- print *,' NX should be exactly divided by the number of processors'
- stop
- endif
-
- nk = nx/2+1
-
- ns1 = nx
- ns2 = ny
- ns3 = nz/nproc
-
- nxs = 1
- nxe = nx
-
- nys = 1
- nye = ny
-
- nzs = 1 +(rank)*ns3
- nze = (rank+1)*ns3
-
-
- fns1 = nk
- fns2 = ny/nproc
- fns3 = nz
-
- fnxs = 1
- fnxe = nk
-
- fnys = 1 + (rank)*fns2
- fnye = (rank+1)*fns2
-
- fnzs = 1
- fnze = fns3
-
-!!$
-!!$ print *,' After getdims 11', rank, nxs,nxe,ns1
-!!$ print *,' After getdims 12', rank, nys,nye,ns2
-!!$ print *,' After getdims 13', rank, nzs,nze,ns3
-!!$
-!!$
-!!$
-!!$ print *,' dimensions 31', rank, fnxs, fnxe, fns1
-!!$ print *,' dimensions 32', rank, fnys, fnye, fns2
-!!$ print *,' dimensions 33', rank, fnzs, fnze, fns3
-!!$
-
-
-
- call parser_read('Number of points for scalar',nxsc)
- nysc = nxsc
- nzsc = nxsc
-
- if (mod(nzsc,nproc).ne.0) then
- print *,' NXSC should be exactly divided by the number of processors'
- stop
- endif
-
- nksc = nxsc/2+1
-
- ns1sc = nxsc
- ns2sc = nysc
- ns3sc = nzsc/nproc
-
- nxssc = 1
- nxesc = nxsc
-
- nyssc = 1
- nyesc = nysc
-
- nzssc = 1 +(rank)*ns3sc
- nzesc = (rank+1)*ns3sc
-
- fns1sc = nksc
- fns2sc = nysc/nproc
- fns3sc = nzsc
-
- fnxssc = 1
- fnxesc = nksc
-
- fnyssc = 1 + (rank)*fns2sc
- fnyesc = (rank+1)*fns2sc
-
- fnzssc = 1
- fnzesc = fns3sc
-
-
-
- call MPI_TYPE_SIZE(MPI_DOUBLE_PRECISION,size_dp,ierr)
- if (WP.eq.size_dp) then
- MPI_REAL_WP = MPI_DOUBLE_PRECISION
- else
- MPI_REAL_WP = MPI_REAL
- endif
-
- call MPI_TYPE_SIZE(MPI_DOUBLE_COMPLEX,size_dp,ierr)
-
- if ((2*WP).eq.size_dp) then
- MPI_COMPLEX_WP = MPI_DOUBLE_COMPLEX
- else
- MPI_COMPLEX_WP = MPI_COMPLEX
- endif
-
-
-end subroutine mpi_initialize
-
-
-subroutine parallel_max(gmax,mdummy)
-
- use parallel
- use precision
- implicit none
-
- real(WP) :: gmax, mdummy
- integer :: ierr
-
- call MPI_ALLREDUCE(gmax,mdummy,1,MPI_REAL_WP,MPI_MAX,&
- &MPI_COMM_WORLD,ierr)
-
- gmax = mdummy
-
-end subroutine parallel_max
-
-subroutine barrier
-
- use parallel
-
- implicit none
-
- integer :: ierr
-
- call MPI_BARRIER(MPI_COMM_WORLD,ierr)
-
-end subroutine barrier
diff --git a/Code_LEGI/parinit.f90 b/Code_LEGI/parinit.f90
deleted file mode 100755
index 20f7dd9dc36289d1f869e4cc46ae3d1c39c0bc97..0000000000000000000000000000000000000000
--- a/Code_LEGI/parinit.f90
+++ /dev/null
@@ -1,601 +0,0 @@
-subroutine hit_init
-
- use parallel
- use transform
- use data
- implicit none
-! include 'fftw3.f'
-
- ! Spectrum computation
- real(WP) :: psr,ps1,ps2, xx, yy, zz
- real(WP) :: ke,kd,ks,dk,ksk0ratio,kc,kcksratio,kk,kx,ky,kz,kk2,kcut
- real(WP) :: alpha,spec_amp,eps,amp_disc,f_phi,sch
- integer :: kl,jl,il,impose,simtype
- real(WP) :: e_total,energy_spec,diss_total,ndense
- real(WP), dimension(:,:), pointer :: spect,sg
- real(WP), dimension(:), pointer :: s1,tabs2
- complex(WP), dimension(:,:,:), pointer :: ak,bk
- real(WP) :: scmean,scmean_global
- ! Other
- integer :: i,j,k,ik,iunit,dim
- real(WP), dimension(:), pointer :: nnodes
- complex(WP) :: ii=(0.0_WP,1.0_WP)
- real(WP) :: rand,pi,spec,kfix
-
- real(WP) :: keta, Rlambda, L11, tke,L_large, dissipation,eta
- real(WP) :: e_spec,d_spec, e_local, d_local, spec_factor
- ! Fourier coefficients
- real(WP) :: umax,vmax,wmax,cos,sin
- complex(WP), dimension(:,:,:), pointer :: Uk,Vk,Wk,scalar
- complex(WP), dimension(:,:,:), pointer :: Cbuf
- real(WP), dimension(:,:,:), pointer :: Rbuf
-
- logical :: flg_inplace
-
- integer :: ierr,gg(3),iforce,iscal
- integer,dimension(:,:,:),pointer :: node_index
- integer(KIND=8) :: plan_c2r
-
-!!$ real(WP), dimension(:,:,:), pointer :: A
-!!$ complex(WP), dimension(:,:,:), pointer :: B
-
- call parser_read('Kmax eta', keta)
- call parser_read('R Lambda', Rlambda)
- call parser_read('Forcing', iforce)
-
- if (trim(spectrum).eq.'VKP') then
- call parser_read('Dissipative scale',ld)
- call parser_read('Dissipation',epsilon)
- end if
-
- ! Create pi
- pi = acos(-1.0_WP)
-
-!!$ ! =================
-!!$ ! Velocity Spectrum
-!!$
-!!$ ! Spectrum computation
-!!$ ke = 2.0_WP*pi/le
-!!$ if (trim(spectrum).eq.'VKP') kd = 2.0_WP*pi/ld
-!!$ dk = 2.0_WP*pi/L
-!!$ kc = real(nx/2,WP)*dk
-!!$ eps=ke/1000000.0_WP
-!!$ if (trim(spectrum).eq.'PP') then
-!!$ spec_amp = 16.0_WP*sqrt(2.0_WP/pi)*Ut**2/ke
-!!$ else if (trim(spectrum).eq.'VKP') then
-!!$ alpha=1.5_WP
-!!$ spec_amp = 1.5_WP*Ut**5/epsilon
-!!$ end if
-!!$ amp_disc = sqrt(dk)**3
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!! Modified Input for the Spectral Code
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
-!!!! Need to input Viscosity, kmax X eta, R_Lambda
-
-!!!!! Assumes high-reynolds limit to determine the largest eddy
-!!!!! Equations for Pope's book, chapter 6
-
-
-
- eta = (2.0_WP*keta)/real(nx,WP)
- L_large = eta*(3.0_WP/20.0_WP*Rlambda*Rlambda)**(3.0/4.0)
-
- L11 = L_large*0.43
-
- ke = 1.3_WP/L11
-
- if (ke.lt.1) then
- print *,' Peak wavenumber not in the box, reduce R Lambda'
- call parser_read('Re-init scalar', iscal)
- if(iscal.eq.0) then
- stop
- end if
- endif
-
-
- dk = 2.0_WP*pi/L
- kc = pi*real(nx,WP)/L
- eps = kc/10000000_WP
-
-
- e_spec = 0.0_WP
- d_spec = 0.0_WP
-
- ndense = 0.0_WP
-
- do k = fnzs,fnze
- do j = fnys,fnye
- do i = fnxs,fnxe
- kx=real(i-1,WP)*dk
- ky=real(j-1,WP)*dk
- if (j.gt.nk) ky=-real(nx+1-j,WP)*dk
- kz=real(k-1,WP)*dk
- if (k.gt.nk) kz=-real(nx+1-k,WP)*dk
- kk=sqrt(kx**2+ky**2+kz**2)
- if ((kk.gt.eps).and.(kk.le.kc)) then
- ndense = ndense + 1.0_WP
- energy_spec = (kk/ke)**4.0_WP*exp(-2.0_WP*(kk/ke)**2.0_WP)/(4.0_WP*pi*kk**2.0_WP)
- e_spec = e_spec + dk*energy_spec
- d_spec = d_spec + dk*kk**2.0_WP*energy_spec
- endif
- enddo
- enddo
- enddo
-
- e_local = e_spec
- d_local = d_spec
- call MPI_ALLREDUCE(e_local,e_spec,1,MPI_REAL_WP,MPI_SUM,&
- & MPI_COMM_WORLD,ierr)
- call MPI_ALLREDUCE(d_local,d_spec,1,MPI_REAL_WP,MPI_SUM,&
- & MPI_COMM_WORLD,ierr)
-
-
- spec_amp = 3.0_WP/10.0_WP*Rlambda**2.0_WP*mu**2.0_WP*d_spec/e_spec**2.0_WP
-
-!mu = sqrt(e_spec**2.0_WP/d_spec*(10.0_WP/(3.0_WP*Rlambda**2.0_WP)))
- tke = spec_amp*e_spec
-
- Ut = sqrt(tke/1.5_WP) !Rlambda*mu/(sqrt(10.0_WP)*eta**(2.0_WP/3.0_WP)*L_large**(1.0_WP/3.0_WP))
-! tke = 1.5_WP*Ut*Ut
- dissipation = 2.0_WP*mu*spec_amp*d_spec
- amp_disc = sqrt(dk)**3.0_WP
-
-
- if (rank.eq.0) then
- print *, '------------------------------------------------------------------'
- print *, '------------------------------------------------------------------'
- print *,' L11 ', L11
- print *,' L_large ', L_large
- print *,' kc ', kc
- print *,' ke ', ke
- print *,' eta ', eta
- print *,' Ut ', Ut
- print *,' kinetic energy ', tke
- print *,' dissipation ', dissipation
- print *,' spec_amp ', spec_amp
- print *,' amp_disc ', amp_disc
- print *,' viscosity', mu
- print *,' e_spec ', e_spec
- print *,' d_spec ', d_spec
- print *,' Number of modes', ndense
- print *,' R lambda calculated', sqrt(20.0_WP/3.0_WP*tke**2.0/(dissipation*mu))
- print *, '------------------------------------------------------------------'
- print *, '------------------------------------------------------------------'
- endif
-
-
-
- ! Output spectrum for comparison
- allocate(spect(2,nx+1))
- e_total=0.0_WP
- diss_total = 0.0_WP
- spect = 0.0_WP
-
-
- ! Compute spectrum
-
- allocate(ak(fnxs:fnxe,fnys:fnye,fnzs:fnze),bk(fnxs:fnxe,fnys:fnye,fnzs:fnze))
- !allocate(nnodes(nx+1))
- !nnodes = 0.0_WP
- ndense = 0.0_WP
- do k=fnzs,fnze
- do j=fnys,fnye
- do i=fnxs,fnxe
- ! Random numbers
- call random_number(rand)
- psr= 2.0_WP*pi*rand !2.0_WP*pi*(rand-0.5_WP)
- call random_number(rand)
- ps1=2.0_WP*pi*rand !*(rand-0.5_WP)
- call random_number(rand)
- ps2=2.0_WP*pi*rand !(rand-0.5_WP)
- ! Wavenumbers
- kx=real(i-1,WP)*dk
- ky=real(j-1,WP)*dk
- if (j.gt.nk) ky=-real(nx+1-j,WP)*dk
- kz=real(k-1,WP)*dk
- if (k.gt.nk) kz=-real(nx+1-k,WP)*dk
- kk=sqrt(kx**2.+ky**2.+kz**2.)
- ! Spectrums
- energy_spec=spec_amp*(kk/ke)**4.0_WP*exp(-2.0_WP*(kk/ke)**2.0_WP)
- ! Coeff
- ik = 1+idint(kk/dk + 0.5_WP)
- if ((kk.gt.eps).and.(kk.le.kc)) then
- ndense = ndense + 1.0_WP
- ak(i,j,k)= amp_disc*sqrt(energy_spec/(4.0_WP*pi*kk**2.0_WP))*exp(ii*ps1)*cos(psr)
- bk(i,j,k)= amp_disc*sqrt(energy_spec/(4.0_WP*pi*kk**2.0_WP))*exp(ii*ps2)*sin(psr)
- spect(2,ik) = spect(2,ik) + real(ak(i,j,k)*conjg(ak(i,j,k))) + real(bk(i,j,k)*conjg(bk(i,j,k)))
- e_total = e_total + dk*(real(ak(i,j,k)*conjg(ak(i,j,k))) + real(bk(i,j,k)*conjg(bk(i,j,k))))
- diss_total = diss_total + dk*2.0_WP*mu*kk**2.0_WP*(real(ak(i,j,k)*conjg(ak(i,j,k)))&
- & + real(bk(i,j,k)*conjg(bk(i,j,k))))
- end if
- end do
- end do
- end do
-
- e_local = e_total
- d_local = diss_total
- allocate(tabs2(1:nx+1))
- tabs2 = 0.0_WP
- call MPI_ALLREDUCE(spect(2,:),tabs2,nx+1,MPI_REAL_WP,MPI_SUM,MPI_COMM_WORLD,ierr)
- call MPI_ALLREDUCE(e_local,e_total,1,MPI_REAL_WP,MPI_SUM,&
- & MPI_COMM_WORLD,ierr)
- call MPI_ALLREDUCE(d_local,diss_total,1,MPI_REAL_WP,MPI_SUM,&
- & MPI_COMM_WORLD,ierr)
- spect(2,:) = tabs2
- deallocate(tabs2)
-
-
-!!$ if (rank.eq.0) then
-!!$ print *,' Total energy ', e_total, tke
-!!$ print *,' Total dissipation ', diss_total, dissipation
-!!$ print *,' Number of modes ', ndense
-!!$ endif
-
- iunit=iopen()
- open(iunit,file='spectrum.analytic',form='formatted')
- do i=1,nx+1
- spect(1,i) = real(i-1,WP)*dk
- if ((spect(1,i).ne.0.0_WP).and.(spect(2,i).ne.0.0_WP)) then
- write(11,*) spect(1,i),',',spect(2,i)
- end if
- end do
- close(iclose(iunit))
-
-
-
- ! Compute 3D velocity field
- allocate(Uk(fns1,fns2,fns3))
- allocate(Vk(fns1,fns2,fns3))
- allocate(Wk(fns1,fns2,fns3))
-
- Uk=(0.0_WP,0.0_WP)
- Vk=(0.0_WP,0.0_WP)
- Wk=(0.0_WP,0.0_WP)
-
-
-
- ! Compute the Fourier coefficients
- do k=fnzs,fnze
- kl = k - fnzs + 1
- do j=fnys,fnye
- jl = j - fnys +1
- do i=fnxs,fnxe
-
- ! Wavenumbers
- kx=real(i-1,WP)*dk
- ky=real(j-1,WP)*dk
- if (j.gt.nk) ky=-real(nx-j+1,WP)*dk
- kz=real(k-1,WP)*dk
- if (k.gt.nk) kz=-real(nx-k+1,WP)*dk
- kk =sqrt(kx**2+ky**2+kz**2)
- kk2=sqrt(kx**2+ky**2)
-
- il = i - fnxs+1
- ! Compute the Fourier coefficients
- if ((kk.gt.eps).and.(kk.le.kc)) then
- if (kk2.lt.eps) then
- Uk(il,jl,kl)=(ak(i,j,k)+bk(i,j,k))/sqrt(2.0_WP)
- else
- Uk(il,jl,kl)=(ak(i,j,k)*kk*ky+bk(i,j,k)*kx*kz)/(kk*kk2)
- end if
- if (kk2.lt.eps) then
- Vk(il,jl,kl)=(bk(i,j,k)-ak(i,j,k))/sqrt(2.0_WP)
- else
- Vk(il,jl,kl)=(bk(i,j,k)*ky*kz-ak(i,j,k)*kk*kx)/(kk*kk2)
- end if
- Wk(il,jl,kl)=-bk(i,j,k)*kk2/kk
- end if
- end do
- end do
- end do
-
- deallocate(ak)
- deallocate(bk)
-
-
-
-!!$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!$!!!! ODDBALL NOT PROPERLY HANDLED - NEED TO BE FIXED
-!!$!!!! FOR NOW - ONLY THE SIMPLE BOUNDARY (1,1,K) HANDLED
-!!$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!$
-!!$ ! Oddball
-!!$ do k=2,nx
-!!$ do j=nk+1,nx
-!!$ Uk(1,j,k)=conjg(Uk(1,ny+2-j,nz+2-k))
-!!$ Vk(1,j,k)=conjg(Vk(1,ny+2-j,nz+2-k))
-!!$ Wk(1,j,k)=conjg(Wk(1,ny+2-j,nz+2-k))
-!!$ end do
-!!$ end do
-
- do k=nk+1,fns3
- Uk(1,1,k)=conjg(Uk(1,1,nz+2-k))
- Vk(1,1,k)=conjg(Vk(1,1,nz+2-k))
- Wk(1,1,k)=conjg(Wk(1,1,nz+2-k))
- end do
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
- call parser_read('Simulation type',simtype)
- if(simtype.eq.0) then
-
- call btran_wrap(Uk,U,ns1,ns2,ns3,fns1,fns2,fns3)
- call btran_wrap(Vk,V,ns1,ns2,ns3,fns1,fns2,fns3)
- call btran_wrap(Wk,W,ns1,ns2,ns3,fns1,fns2,fns3)
-
-!!!!!!!!!
-!! Simple correction to enforce energy spectrum after transform
-!! Convert back to wavenumber space and force spectrum
-!!!!!!!!!
-
-
-
- call ftran_wrap(U,Uk,ns1,ns2,ns3,fns1,fns2,fns3)
- call ftran_wrap(V,Vk,ns1,ns2,ns3,fns1,fns2,fns3)
- call ftran_wrap(W,Wk,ns1,ns2,ns3,fns1,fns2,fns3)
- end if
-
- Uk = Uk/real(ns1**3.0_WP,WP)
- Vk = Vk/real(ns1**3.0_WP,WP)
- Wk = Wk/real(ns1**3.0_WP,WP)
-
-
- allocate(sg(2,nx+1),s1(nx+1))
- s1 = 0.0_WP
- !nnodes = 0
-
- allocate(node_index(fns1,fns2,fns3))
-
- do k = 1,fns3
- do j = 1,fns2
- do i = 1,fns1
- il = i + fnxs -1
- jl = j + fnys -1
- kl = k + fnzs -1
- kx=real(il-1,WP)*dk
- ky=real(jl-1,WP)*dk
- if (jl.gt.nk) ky=-real(nx-jl+1,WP)*dk
- kz=real(kl-1,WP)*dk
- if (kl.gt.nk) kz=-real(nx-kl+1,WP)*dk
- kk =sqrt(kx**2+ky**2+kz**2)
- ik = 1+idint(kk/dk + 0.5_WP)
- node_index(i,j,k) = ik
- if (kk.gt.eps.and.kk.le.kc) then
- s1(ik) = s1(ik) + real(Uk(i,j,k)*conjg(Uk(i,j,k))) + &
- & real(Vk(i,j,k)*conjg(Vk(i,j,k))) +&
- & real(Wk(i,j,k)*conjg(Wk(i,j,k)))
-
- endif
- enddo
- enddo
- enddo
-
-
- call MPI_ALLREDUCE(s1,sg(2,:),nx+1,MPI_REAL_WP,MPI_SUM,&
- &MPI_COMM_WORLD,ierr)
- do i = 1,nx+1
- sg(1,i) = real(i-1,WP)*dk
- if (sg(2,i).gt.1e-20_WP) then
- sg(2,i) = spect(2,i)/sg(2,i)
- else
- sg(2,i) = 1.0_WP
- endif
- enddo
-
- do k = 1,fns3
- do j = 1,fns2
- do i = 1,fns1
- Uk(i,j,k) = Uk(i,j,k)*sqrt(sg(2,node_index(i,j,k)))
- Vk(i,j,k) = Vk(i,j,k)*sqrt(sg(2,node_index(i,j,k)))
- Wk(i,j,k) = Wk(i,j,k)*sqrt(sg(2,node_index(i,j,k)))
- enddo
- enddo
- enddo
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!! End of correction
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- call parallel_max(maxval(abs(Uk)),umax)
- call parallel_max(maxval(abs(Vk)),vmax)
- call parallel_max(maxval(abs(Wk)),wmax)
-
-
-!!$ if (rank.eq.0) then
-!!$ print *,' Maximum U,V,W after transforms',umax,vmax,wmax
-!!$ endif
-!!$ if (umax.eq.maxval(abs(Uk))) then
-!!$ print *,' In processor rank ', rank
-!!$ print *,' Location of maximum ', maxloc(abs(Uk))
-!!$ gg = maxloc(abs(Uk))
-!!$ print *,' Maximum value ', Uk(gg(1),gg(2),gg(3))
-!!$ endif
-!!$ if (wmax.eq.maxval(abs(Wk))) then
-!!$ print *,' In processor rank ', rank
-!!$ print *,' Location of maximum ', maxloc(abs(Wk))
-!!$ gg = maxloc(abs(Wk))
-!!$ print *,' Maximum value ', Wk(gg(1),gg(2),gg(3))
-!!$ endif
-
-!!$ call data_write_fourier(Uk,Vk,Wk,fns1,fns2,fns3)
-
- if(simtype.eq.0) then
-
- call btran_wrap(Uk,U,ns1,ns2,ns3,fns1,fns2,fns3)
- call btran_wrap(Vk,V,ns1,ns2,ns3,fns1,fns2,fns3)
- call btran_wrap(Wk,W,ns1,ns2,ns3,fns1,fns2,fns3)
-
- end if
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!! End of velocity initialization
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! Input for scalar field
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
- call parser_read('ks/ko', ksk0ratio)
- ks = ksk0ratio*dk
-!!! Assume kc/ks to be 2 as in Eswaran and Pope
- kc = 2.0_WP*ks
-
-
- allocate(scalar(fns1sc,fns2sc,fns3sc))
-
- scalar = (0.0_WP,0.0_WP)
- if(rank.eq.0) print*,'test nksc',nksc
-
- do k = 1,fns3sc
- do j = 1,fns2sc
- do i = 1,fns1sc
- il = i + fnxssc - 1
- jl = j + fnyssc - 1
- kl = k + fnzssc - 1
-
- kx=real(il-1,WP)*dk
- ky=real(jl-1,WP)*dk
- if (jl.gt.nksc) ky=-real(nxsc-jl+1,WP)*dk
- kz=real(kl-1,WP)*dk
- if (kl.gt.nksc) kz=-real(nxsc-kl+1,WP)*dk
- kk =sqrt(kx**2+ky**2+kz**2)
- kk2=sqrt(kx**2+ky**2)
- if ((ks-dk/2.0_WP.le.kk).and.(kk.le.ks+dk/2.0_WP)) then
- f_phi = 1.0_WP
- else
- f_phi = 0.0_WP
- endif
- call random_number(rand)
- if (kk.lt.1e-10) then
- scalar(i,j,k) = 0.0_WP
- else
- scalar(i,j,k) = sqrt(f_phi/(4.0_WP*pi*kk**2.0_WP))*exp(ii*2.0_WP*pi*rand)
- endif
- enddo
- enddo
- enddo
-
-
- call btran_wrap(scalar,SC,ns1sc,ns2sc,ns3sc,fns1sc,fns2sc,fns3sc)
- SC = SC/real(ns1sc**3.0,WP)
-
- do k = 1,ns3sc
- do j = 1,ns2sc
- do i = 1,ns1sc
- if (SC(i,j,k).le.0.0_WP) then
- SC(i,j,k) = 0.0_WP
- else
- SC(i,j,k) = 1.0_WP
- endif
- enddo
- enddo
- enddo
-
- call ftran_wrap(SC,scalar,ns1sc,ns2sc,ns3sc,fns1sc,fns2sc,fns3sc)
-
-! kcut = sqrt(2.0_WP)*real(nxsc,WP)/3.0_WP
- kcut = real(nx,WP)/2.0_WP
-! kcut = real(nxsc,WP)/2.0_WP
- do k = 1,fns3sc
- do j = 1,fns2sc
- do i = 1,fns1sc
- il = i + fnxssc - 1
- jl = j + fnyssc - 1
- kl = k + fnzssc - 1
-
- kx=real(il-1,WP)*dk
- ky=real(jl-1,WP)*dk
- if (jl.gt.nksc) ky=-real(nxsc-jl+1,WP)*dk
- kz=real(kl-1,WP)*dk
- if (kl.gt.nksc) kz=-real(nxsc-kl+1,WP)*dk
- kk =sqrt(kx**2+ky**2+kz**2)
- kk2=sqrt(kx**2+ky**2)
-
- if (kk.gt.kcut) scalar(i,j,k) = 0.0_WP
-
- if (kk.le.kc) then
- scalar(i,j,k) = scalar(i,j,k)
- else
- scalar(i,j,k) = scalar(i,j,k)*(kc/kk)**2.0_WP
- endif
- enddo
- enddo
- enddo
-
- call btran_wrap(scalar,SC,ns1sc,ns2sc,ns3sc,fns1sc,fns2sc,fns3sc)
- SC = SC/real(ns1sc**3.0,WP)
-
-
- call parser_read('Imposing mean gradient',impose,0)
-
-
-! if (impose.eq.1) then
-! scmean = 0.0_WP
-! do k = 1,ns3
-! do j = 1,ns2
-! do i = 1,ns1
-! scmean = scmean + SC(i,j,k)
-! enddo
-! enddo
-! enddo
-
-! call MPI_ALLREDUCE(scmean,scmean_global,1,MPI_REAL_WP,MPI_SUM,&
-! &MPI_COMM_WORLD,ierr)
-
-! scmean = scmean_global/(real(nx,WP)**3.0_WP)
-
-!!!!!!!!!!!! Setting scalar to zero - see if it lies within bounds
-! do k = 1,ns3
-! do j = 1,ns2
-! do i = 1,ns1
-! SC(i,j,k) = 0.0_WP
-! enddo
-! enddo
-! enddo
-
-! endif
-
-
- ! Inverse Fourier transform
-
- ! Clean up
- deallocate(Uk)
- deallocate(Vk)
- deallocate(Wk)
- deallocate(scalar)
- deallocate(node_index)
- deallocate(s1)
- deallocate(sg)
- deallocate(spect)
-
- spfilename = 'spectrum_init'
- spfilename2 = 'spectrum_init.scalar'
- call get_dns_numbers(1)
-
-! do i = 1, ns1sc
-! do j = 1, ns2sc
-! do k = 1, ns3sc
-! xx = i*L/ns1sc - L/2
-! yy = j*L/ns2sc - L/2
-! zz = k*L/ns3sc - L/2
-! SC(i,j,k) = sqrt(xx**2.0 + yy**2.0 + zz**2.0)
-! end do
-! end do
-! end do
-
-
-
-! do i = 1, nxsc
-! SC(i,:,:) = sin(real(i)/real(nxsc)*L)
-! end do
-
-
-
-end subroutine hit_init
-
-
diff --git a/Code_LEGI/parser.f90 b/Code_LEGI/parser.f90
deleted file mode 100755
index c9b19f0399c3b85f10623d9d14933f81c5666d5d..0000000000000000000000000000000000000000
--- a/Code_LEGI/parser.f90
+++ /dev/null
@@ -1,428 +0,0 @@
-module parser
- use precision
- implicit none
-
- ! Input values storage
- integer, parameter :: tag_length=128
- integer, parameter :: line_length=40960
- integer :: nfields
- type entry_type
- character(tag_length) :: tag
- character(line_length) :: value
- end type entry_type
- type(entry_type), pointer, dimension(:) :: entries
-
- ! Define interface for reading
- interface parser_read
- module procedure parser_readlogical
- module procedure parser_readint
- module procedure parser_readintarray
- module procedure parser_readfloat
- module procedure parser_readfloatarray
- module procedure parser_readfloatarray2D
- module procedure parser_readchar
- module procedure parser_readchararray
- end interface
-
-contains
-
- ! Pack the structure -----------------------------------------------------
- subroutine parser_pack(myfield)
- implicit none
- integer,intent(in) :: myfield
- type(entry_type), pointer, dimension(:) :: entries_new
-
- allocate(entries_new(nfields-1))
- entries_new(1:myfield-1) = entries(1:myfield-1)
- entries_new(myfield:nfields-1) = entries(myfield+1:nfields)
- deallocate(entries)
- nullify(entries)
- entries => entries_new
- nfields = nfields-1
-
- return
- end subroutine parser_pack
-
- ! Spread the structure ---------------------------------------------------
- subroutine parser_spread
- implicit none
- type(entry_type), pointer, dimension(:) :: entries_new
-
- if (nfields .ne. 0) then
- allocate(entries_new(nfields+1))
- entries_new(1:nfields) = entries(1:nfields)
- deallocate(entries)
- nullify(entries)
- entries => entries_new
- else
- allocate(entries(1))
- end if
- nfields = nfields+1
-
- return
- end subroutine parser_spread
-
- ! Add a new entry in the structure ----------------------------------------
- subroutine parser_newentry(mytag,myvalue)
- implicit none
- character(*),intent(in) :: mytag
- character(*),intent(in) :: myvalue
- integer :: ifield
- logical :: isdef
-
- call parser_fieldfortag(mytag,ifield,isdef)
- if (.not. isdef) then
- call parser_spread()
- entries(nfields)%tag=mytag
- entries(nfields)%value=myvalue
- else
- entries(ifield)%value=myvalue
- end if
-
- return
- end subroutine parser_newentry
-
- ! Get filed number from tag ----------------------------------------------
- subroutine parser_fieldfortag(mytag,myfield,isdef)
- implicit none
- character(*),intent(in) :: mytag
- integer,intent(out) :: myfield
- logical,optional,intent(out) :: isdef
- integer :: ifield
-
- isdef = .false.
- do ifield=1,nfields
- if (entries(ifield)%tag==mytag) then
- myfield=ifield
- isdef = .true.
- return
- end if
- end do
-
- return
- end subroutine parser_fieldfortag
-
- ! Check whether the field is defined -------------------------------------
- subroutine parser_is_defined(mytag,isdef)
- implicit none
-
- character(*),intent(in) :: mytag
- logical,intent(out) :: isdef
- integer :: ifield
-
- call parser_fieldfortag(mytag,ifield,isdef)
-
- return
- end subroutine parser_is_defined
-
- ! Read logicals ---------------------------------------------
- subroutine parser_readlogical(mytag,value,default)
- implicit none
-
- character(*),intent(in) :: mytag
- logical,intent(out) :: value
- logical,optional,intent(in) :: default
- integer :: ifield
- logical :: isdef
-
- call parser_fieldfortag(mytag,ifield,isdef)
- if (.not.isdef .AND. present(default)) then
- value = default
- else if (.not.isdef .AND. .not.present(default)) then
- print*,'Parser : '// mytag //' not defined'
- stop
- else
- read(entries(ifield)%value,*) value
- end if
-
- return
- end subroutine parser_readlogical
-
- ! Read integers ---------------------------------------------
- subroutine parser_readint(mytag,value,default)
- implicit none
-
- character(*),intent(in) :: mytag
- integer,intent(out) :: value
- integer,optional,intent(in) :: default
- integer :: ifield
- logical :: isdef
-
- call parser_fieldfortag(mytag,ifield,isdef)
- if (.not.isdef .AND. present(default)) then
- value = default
- else if (.not.isdef .AND. .not.present(default)) then
- print*,'Parser : '// mytag //' not defined'
- stop
- else
- read(entries(ifield)%value,*) value
- end if
-
- return
- end subroutine parser_readint
-
- ! Read floats ---------------------------------------------
- subroutine parser_readfloat(mytag,value,default)
- implicit none
-
- character(*),intent(in) :: mytag
- real(WP),intent(out) :: value
- real(WP),optional,intent(in) :: default
- integer :: ifield
- logical :: isdef
-
- call parser_fieldfortag(mytag,ifield,isdef)
- if (.not.isdef .AND. present(default)) then
- value = default
- else if (.not.isdef .AND. .not.present(default)) then
- print*,'Parser : '// mytag //' not defined'
- stop
- else
- read(entries(ifield)%value,*) value
- end if
-
- return
- end subroutine parser_readfloat
-
- ! Read characters ---------------------------------------------
- subroutine parser_readchar(mytag,value,default)
- implicit none
-
- character(*),intent(in) :: mytag
- character(len=*),intent(out) :: value
- character(len=*),optional,intent(in) :: default
- integer :: ifield
- logical :: isdef
-
- call parser_fieldfortag(mytag,ifield,isdef)
- if (.not.isdef .AND. present(default)) then
- value = default
- else if (.not.isdef .AND. .not.present(default)) then
- print*,'Parser : '// mytag //' not defined'
- stop
- else
- read(entries(ifield)%value,'(a)') value
- end if
-
- return
- end subroutine parser_readchar
-
- ! Count size of the arrays ----------------------------------------
- subroutine parser_getsize(mytag,numb)
- implicit none
-
- character(*),intent(in) :: mytag
- integer,intent(out) :: numb
- integer :: ifield
- logical :: isdef
- integer :: i
- integer, dimension(line_length) :: counter
-
- ! Read it now
- call parser_fieldfortag(mytag,ifield,isdef)
- if (.not. isdef) then
- print*,'Parser : '// mytag //' not defined'
- stop
- end if
-
- ! Count the number of entries
- counter = 0
- do i=1,len_trim(entries(ifield)%value)
- if (entries(ifield)%value(i:i).EQ.' ') counter(i)=1
- end do
- do i=1+1,len_trim(entries(ifield)%value)
- if (counter(i).EQ.1 .AND. counter(i-1).EQ.1) counter(i-1)=0
- end do
- numb = sum(counter)+1
-
- return
- end subroutine parser_getsize
-
- ! Read integer arrays ---------------------------------------------
- subroutine parser_readintarray(mytag,value)
- implicit none
-
- character(*),intent(in) :: mytag
- integer,dimension(:),intent(out) :: value
- integer :: ifield
- logical :: isdef
-
- ! Read them
- call parser_fieldfortag(mytag,ifield,isdef)
- if (.not. isdef) then
- print*,'Parser : '// mytag //' not defined'
- stop
- end if
- read(entries(ifield)%value,*) value
-
- return
- end subroutine parser_readintarray
-
- ! Read float arrays ---------------------------------------------
- subroutine parser_readfloatarray(mytag,value)
- implicit none
-
- character(*),intent(in) :: mytag
- real(WP),dimension(:),intent(out) :: value
- integer :: ifield
- logical :: isdef
-
- ! Read them
- call parser_fieldfortag(mytag,ifield,isdef)
- if (.not. isdef) then
- print*,'Parser : '// mytag //' not defined'
- stop
- end if
- read(entries(ifield)%value,*) value
-
- return
- end subroutine parser_readfloatarray
-
- ! Read float arrays ---------------------------------------------
- subroutine parser_readfloatarray2D(mytag,value)
- implicit none
-
- character(*),intent(in) :: mytag
- real(WP),dimension(:,:),intent(out) :: value
- integer :: ifield
- logical :: isdef
-
- ! Read them
- call parser_fieldfortag(mytag,ifield,isdef)
- if (.not. isdef) then
- print*,'Parser : '// mytag //' not defined'
- stop
- end if
- read(entries(ifield)%value,*) value
-
- return
- end subroutine parser_readfloatarray2D
-
- ! Read float arrays ---------------------------------------------
- subroutine parser_readchararray(mytag,value)
- implicit none
-
- character(*),intent(in) :: mytag
- character(*),dimension(:),intent(out) :: value
- integer :: ifield
- logical :: isdef
-
- ! Read them
- call parser_fieldfortag(mytag,ifield,isdef)
- if (.not. isdef) then
- print*,'Parser : '// mytag //' not defined'
- stop
- end if
- read(entries(ifield)%value,*) value
-
- return
- end subroutine parser_readchararray
-
-end module parser
-
-! Initialize the parser ---------------------------------------------
-subroutine parser_init
- use parser
- use fileio
- implicit none
-
- nfields = 0
- if (associated(entries)) then
- deallocate(entries)
- nullify(entries)
- end if
-
- return
-end subroutine parser_init
-
-! Read & parse the input file ---------------------------------------------
-subroutine parser_parsefile(input)
- use parser
- use fileio
-
- implicit none
- integer :: iunit,ierr,limiter,nlines,i,j,ntags,comment
- integer, dimension(:), allocatable :: limit,line
- character(len=line_length) :: buffer
- character(len=line_length), dimension(:), allocatable :: file
- character(len=line_length) :: value
- character(len=tag_length) :: tag
- character(len=*) :: input
-
- ! Open the file
- ierr = 0
- iunit = iopen()
- open (iunit,file=input,form='formatted',status='old',iostat=ierr)
- if (ierr .ne. 0) stop 'Parser : an input file is required'
-
- ! Count the number of lines in the file
- ierr = 0
- nlines = 0
- do while (ierr .eq. 0)
- read(iunit,'(a)',iostat=ierr) buffer
- nlines = nlines + 1
- end do
- rewind(iunit)
-
- ! Allocate to the right size
- allocate(file(nlines+1),limit(nlines+1),line(nlines+1))
-
- ! Read everything in the buffer
- ierr = 0
- nlines = 0
- loop: do while (ierr .eq. 0)
- read(iunit,'(a)',iostat=ierr) buffer
- if (ierr.ne.0) exit loop
- ! Remove the tabs
- do j=1,line_length
- if (ichar(buffer(j:j)).EQ.9) buffer(j:j)=' '
- end do
- ! Find comments
- comment = scan(buffer,'!#%')
- ! Remove them
- if (comment.NE.0) buffer(comment:) = ''
- ! Trim
- buffer = adjustl(buffer)
- ! Add line
- if (len_trim(buffer).NE.0) then
- nlines = nlines + 1
- file(nlines) = buffer
- end if
- end do loop
-
- ! Close de file
- close(iunit)
- ierr = iclose(iunit)
-
- ! Get the tags
- ntags = 0
- do i=1,nlines
- limiter = index(file(i),':')
- if (limiter.NE.0) then
- ntags = ntags + 1
- line(ntags) = i
- line(ntags+1) = nlines+1
- limit(ntags) = limiter
- end if
- end do
-
- ! Read everything now
- do i=1,ntags
- buffer = ''
- do j=line(i),line(i+1)-1
- if (j==line(i)) then
- buffer = trim(buffer) // trim(file(j))
- else
- buffer = trim(buffer) // ' ' // trim(file(j))
- end if
- end do
- read(buffer(1:limit(i)-1),'(a)') tag
- read(buffer(limit(i)+1:),'(a)') value
- if (len_trim(value).NE.0) then
- value = adjustl(value)
- call parser_newentry(tag,value)
- end if
- end do
-
- return
-end subroutine parser_parsefile
diff --git a/Code_LEGI/postprocess.f90 b/Code_LEGI/postprocess.f90
deleted file mode 100755
index 58a81727e005beda472100417a1605cd1cfe582d..0000000000000000000000000000000000000000
--- a/Code_LEGI/postprocess.f90
+++ /dev/null
@@ -1,218 +0,0 @@
-subroutine postprocess
-
- use solver
- use parallel
- use data
-
- implicit none
- integer :: i,j,k,pas, nxo,nxoz
- character(len=30) :: Filename,pdfufname
- real(WP) :: nd,nut1,nut2,kt1,kt2
- real(WP) :: kk,h,nutm,ktm,Am,Bm,Cm,Dm,scht1,scht2,scht3,scht5,pdfscht5,CAm,DBm
- integer :: ierr,ik,il,jl,kl,iunit
- real(WP) :: pi,kc,eps,buf,epsil,u2,u3,u4,dudx,lambda,u1,epsil2,eta,sch,eta_B,mini,maxi
-
- real(WP), dimension(:,:,:), pointer :: Rbuf
- real(WP), dimension(:,:,:), pointer :: Zsc !vitesses sous maillage du scalaire
- real(WP), dimension(:,:,:), pointer :: T1,T2,T3,diss !flux scalaire
- real(WP), dimension(:,:,:), pointer :: dZdx, dZdy, dZdz, dZdxsc, dZdysc, dZdzsc
- real(WP), dimension(:,:,:), pointer :: NUT,SCHT,KT
- real(WP), dimension(:,:,:), pointer :: tabA,tabB,tabC,tabD
- real(WP), dimension(:), pointer :: cor,sf2,sf3
- complex(WP), dimension(:,:,:), pointer :: d11,d12,d13,d22,d23,d33
- real(WP), dimension(:,:), pointer :: S1,S2,S3,Sg
- real(WP), dimension(:,:), pointer :: S11,S21,S31,Sg1
-
-
- real(WP), dimension(:,:,:), pointer :: z
- real(WP), dimension(:), pointer :: xx,pdf
- integer :: dime
-
-
-!!! Uk, Vk, Wk and Zk the three component of velocity and scalar in spectral space
-
- dime = 200
- allocate(xx(dime))
- allocate(pdf(dime))
- call c_pdf_sca(xx,pdf,SC,dime)
- if(rank.eq.0) then
- open(14,file='pdf_z',form='formatted')
- do i=1,dime-1
- write(14,*) xx(i), pdf(i)
- enddo
- close(14)
- endif
- deallocate(xx)
- deallocate(pdf)
-
-
-!!! Energy Spectrum
- spfilename = 'spectrum.post'
- spfilename2 = 'spectrum.post.scalar'
- call get_dns_numbers(1)
-
-
- if (ns1sc.eq.ns1) then
-
- call parser_read('Nx filter output',nxo,0)
-
- nd = real(ns1)/real(nxo)
- !! on 256^3 just cutfilter
- allocate(Usc(ns1,ns2,ns3))
- allocate(Vsc(ns1,ns2,ns3))
- allocate(Wsc(ns1,ns2,ns3))
- allocate(Zsc(ns1,ns2,ns3))
- allocate(T1(ns1,ns2,ns3))
- allocate(T2(ns1,ns2,ns3))
- allocate(T3(ns1,ns2,ns3))
- call speccutfilter(SC,Zsc,nd)
- call speccutfilter(U,Usc,nd)
- call speccutfilter(V,Vsc,nd)
- call speccutfilter(W,Wsc,nd)
- call speccutfilter(U*SC,T1,nd)
- call speccutfilter(V*SC,T2,nd)
- call speccutfilter(W*SC,T3,nd)
- T1 = T1 - Usc*Zsc
- T2 = T2 - Vsc*Zsc
- T3 = T3 - Wsc*Zsc
- allocate(dZdx(ns1,ns2,ns3))
- allocate(dZdy(ns1,ns2,ns3))
- allocate(dZdz(ns1,ns2,ns3))
- call gradient(Zsc,0.0,dZdx,dZdy,dZdz)
-
- allocate(diss(ns1,ns2,ns3))
- diss = T1*dZdx + T2*dZdy + T3*dZdz
-
- T1 = SC
- SC = diss
- file_counter = 1
- call data_write
- SC = T1
- call moyensc(diss,nut1)
- if (rank.eq.0) print*,'mean diss 256-1 :',nut1
-
-
- !! on 256^3 cutfilter + cutfilter of product
- call speccutfilter(U*SC,T1,nd)
- call speccutfilter(V*SC,T2,nd)
- call speccutfilter(W*SC,T3,nd)
- call speccutfilter(Usc*Zsc,diss,nd)
- T1 = T1 - diss
- call speccutfilter(Vsc*Zsc,diss,nd)
- T2 = T2 - diss
- call speccutfilter(Wsc*Zsc,diss,nd)
- T3 = T3 - diss
- call speccutfilter(T1*dZdx,Usc,nd)
- call speccutfilter(T2*dZdy,Vsc,nd)
- call speccutfilter(T3*dZdz,Wsc,nd)
- diss = Usc + Vsc + Wsc
-
- T1 = SC
- SC = diss
- file_counter = 2
- call data_write
- SC = T1
- call moyensc(diss,nut1)
- if (rank.eq.0) print*,'mean diss 256-2 :',nut1
-
- deallocate(diss)
- deallocate(Usc)
- deallocate(Vsc)
- deallocate(Wsc)
- deallocate(Zsc)
- deallocate(T1)
- deallocate(T2)
- deallocate(T3)
-
- nxoz = nxo / nproc
- allocate(Usc(nxo,nxo,nxoz))
- allocate(Vsc(nxo,nxo,nxoz))
- allocate(Wsc(nxo,nxo,nxoz))
- allocate(Zsc(nxo,nxo,nxoz))
- allocate(T1(nxo,nxo,nxoz))
- allocate(T2(nxo,nxo,nxoz))
- allocate(T3(nxo,nxo,nxoz))
-
- call discretisation3(SC,Zsc,ns1,ns2,ns3,nxo,nxo,nxoz)
- call discretisation3(U,Usc,ns1,ns2,ns3,nxo,nxo,nxoz)
- call discretisation3(V,Vsc,ns1,ns2,ns3,nxo,nxo,nxoz)
- call discretisation3(W,Wsc,ns1,ns2,ns3,nxo,nxo,nxoz)
- call discretisation3(U*SC,T1,ns1,ns2,ns3,nxo,nxo,nxoz)
- call discretisation3(v*SC,T2,ns1,ns2,ns3,nxo,nxo,nxoz)
- call discretisation3(W*SC,T3,ns1,ns2,ns3,nxo,nxo,nxoz)
- T1 = T1 - Usc*Zsc
- T2 = T2 - Vsc*Zsc
- T3 = T3 - Wsc*Zsc
-
- allocate(dZdxsc(nxo,nxo,nxoz))
- allocate(dZdysc(nxo,nxo,nxoz))
- allocate(dZdzsc(nxo,nxo,nxoz))
- call gradient(SC,0.0,dZdx,dZdy,dZdz)
- call discretisation3(dZdx,dZdxsc,ns1,ns2,ns3,nxo,nxo,nxoz)
- call discretisation3(dZdy,dZdysc,ns1,ns2,ns3,nxo,nxo,nxoz)
- call discretisation3(dZdz,dZdzsc,ns1,ns2,ns3,nxo,nxo,nxoz)
-
-
- allocate(diss(nxo,nxo,nxoz))
- diss = T1*dZdxsc + T2*dZdysc + T3*dZdzsc
-
- nxsc = nxo
- nysc = nxsc
- nzsc = nxsc
-
- if (mod(nzsc,nproc).ne.0) then
- print *,' NXSC should be exactly divided by the number of processors'
- stop
- endif
-
- nksc = nxsc/2+1
-
- ns1sc = nxsc
- ns2sc = nysc
- ns3sc = nzsc/nproc
-
- nxssc = 1
- nxesc = nxsc
-
- nyssc = 1
- nyesc = nysc
-
- nzssc = 1 +(rank)*ns3sc
- nzesc = (rank+1)*ns3sc
-
- fns1sc = nksc
- fns2sc = nysc/nproc
- fns3sc = nzsc
-
- fnxssc = 1
- fnxesc = nksc
-
- fnyssc = 1 + (rank)*fns2sc
- fnyesc = (rank+1)*fns2sc
-
- fnzssc = 1
- fnzesc = fns3sc
-
- call transform_init
- deallocate(data_storesc)
- call data_init
-
- SC = diss
-
- print*,SC(1,1,1)
- print*,SC(ns1sc,ns2sc,ns3sc)
-
- call moyensc(SC,nut1)
- if (rank.eq.0) print*,'mean diss 64:',nut1
-
- file_counter = 3
- call data_write
-
- else if (ns1sc.lt.ns1) then
-
- print*,'solver_step'
- call solver_step
-
- end if
-
-end subroutine postprocess
diff --git a/Code_LEGI/postprocess5.f90 b/Code_LEGI/postprocess5.f90
deleted file mode 100755
index 69e3b5f77bb11b2a10f1d3f59ada6df610f66673..0000000000000000000000000000000000000000
--- a/Code_LEGI/postprocess5.f90
+++ /dev/null
@@ -1,89 +0,0 @@
-subroutine postprocess5
-!!! FOR SGS STRESS MODEL
-
- use solver
- use parallel
- use data
-
- implicit none
- integer :: i,j,k
- real(WP) :: kk,h,nd,nb,ffsize
- integer :: ierr,ik,il,jl,kl,iunit,dime,ndd,m1
- real(WP) :: pi,kc,eps,buf,epsil,u2,u3,u4,dx,cst1,cst2,cst3
- character*13 filexy1,filexy2,filexy3
- character*13 filepdf1,filepdf2,filepdf3
- character*13 filepdf4,filepdf5,filepdf6
-
- real(WP) :: dudx(ns1,ns2,ns3)
- real(WP) :: dudy(ns1,ns2,ns3)
- real(WP) :: dudz(ns1,ns2,ns3)
- real(WP) :: dvdx(ns1,ns2,ns3)
- real(WP) :: dvdy(ns1,ns2,ns3)
- real(WP) :: dvdz(ns1,ns2,ns3)
- real(WP) :: dwdx(ns1,ns2,ns3)
- real(WP) :: dwdy(ns1,ns2,ns3)
- real(WP) :: dwdz(ns1,ns2,ns3)
- real(WP) :: S11(ns1,ns2,ns3)
- real(WP) :: S12(ns1,ns2,ns3)
- real(WP) :: S13(ns1,ns2,ns3)
- real(WP) :: S22(ns1,ns2,ns3)
- real(WP) :: S23(ns1,ns2,ns3)
- real(WP) :: S33(ns1,ns2,ns3)
- real(WP) :: O11(ns1,ns2,ns3)
- real(WP) :: O12(ns1,ns2,ns3)
- real(WP) :: O13(ns1,ns2,ns3)
- real(WP) :: O22(ns1,ns2,ns3)
- real(WP) :: O23(ns1,ns2,ns3)
- real(WP) :: O33(ns1,ns2,ns3)
- real(WP) :: CQ(ns1,ns2,ns3)
- real(WP) :: w1(ns1,ns2,ns3)
- real(WP) :: w2(ns1,ns2,ns3)
- real(WP) :: w3(ns1,ns2,ns3)
-
- real(WP) :: xx(500), pdf(500)
-
- dime = 500
-
-!!! Uk, Vk, Wk and Zk the three component of velocity and scalar in spectral space
-
-!!! All in spatial space
-
- call gradient(U,0.,dudx,dudy,dudz)
- call gradient(V,0.,dvdx,dvdy,dvdz)
- call gradient(W,0.,dwdx,dwdy,dwdz)
-
- S11 = dudx
- S22 = dvdy
- S33 = dwdz
- S12 = 0.5* (dudy + dvdx)
- S13 = 0.5* (dudz + dwdx)
- S23 = 0.5* (dvdz + dwdy)
- O11 = 0.
- O22 = 0.
- O33 = 0.
- O12 = 0.5* (dudy - dvdx)
- O13 = 0.5* (dudz - dwdx)
- O23 = 0.5* (dvdz - dwdy)
- CQ = 0.5*(O11*O11 - S11*S11 + O22*O22 - S22*S22 + O33*O33 - S33*S33 + &
- & 2.0*(O12*O12 - S12*S12 + O13*O13 - S13*S13 + O23*O23 - S23*S23))
- w1 = dwdy - dvdz
- w2 = dudz - dwdx
- w3 = dvdx - dudy
-
- if (rank.eq.0) call dump_geometry
- if (rank.eq.0) call dump_geometry_scalar
- call dump_data(U,'paravie_vel_1')
- call dump_data(V,'paravie_vel_2')
- call dump_data(W,'paravie_vel_3')
- call dump_data(w1,'paravie_vor_1')
- call dump_data(w2,'paravie_vor_2')
- call dump_data(w3,'paravie_vor_3')
- call dump_data(CQ,'paravie_critQ')
- call dump_data_sc(SC,'paravie_scalr')
- O11 = w1*w1 + w2*w2 + w3*w3
- O33 = U*U + V*V + W*W
- call dump_data(O11,'paravie_vor_e')
- call dump_data(O33,'paravie_vel_e')
-
-
-end subroutine postprocess5
diff --git a/Code_LEGI/postprocess6.f90 b/Code_LEGI/postprocess6.f90
deleted file mode 100755
index 9d9b01a6e2988f40e4ec7eaf21cdeb49e70c7d7a..0000000000000000000000000000000000000000
--- a/Code_LEGI/postprocess6.f90
+++ /dev/null
@@ -1,56 +0,0 @@
-subroutine postprocess6
-
- use solver
- use parallel
- use data
-
- implicit none
- integer :: i,j,k,pas,ns1ne,ns2ne,ns3ne
- character(len=30) :: Filename
- integer :: ierr,ik,il,jl,kl,iunit
-
- real(WP), dimension(:,:,:), pointer :: Une,Vne,Wne,Zne ! vitesses pour nouveau maillage
- integer :: dime
-
-!!! INTEGER
-
- call parser_read('New discretisation',ns1ne)
- ns2ne = ns1ne
- ns3ne = ns1ne/nproc
-
-
-!!! TRANSFOMATION DE LA DISCRETISATION DE NX^3 EN NXNE^3
-
- if (rank.eq.0) print*,'allocation des tableaux',ns1ne
- allocate(Une(ns1ne,ns2ne,ns3ne))
- allocate(Vne(ns1ne,ns2ne,ns3ne))
- allocate(Wne(ns1ne,ns2ne,ns3ne))
- allocate(Zne(ns1ne,ns2ne,ns3ne))
- Une = 0.0
- Vne = 0.0
- Wne = 0.0
- Zne = 0.0
- if (rank.eq.0) print*,'changement de discretisation U'
- call discretisation2(U,Une,ns1,ns2,ns3,ns1ne,ns2ne,ns3ne)
- if (rank.eq.0) print*,'changement de discretisation V'
- call discretisation2(V,Vne,ns1,ns2,ns3,ns1ne,ns2ne,ns3ne)
- if (rank.eq.0) print*,'changement de discretisation W'
- call discretisation2(W,Wne,ns1,ns2,ns3,ns1ne,ns2ne,ns3ne)
- if (rank.eq.0) print*,'changement de discretisation Z'
- call discretisation2(SC,Zne,ns1sc,ns2sc,ns3sc,ns1ne,ns2ne,ns3ne)
-
- if (rank.eq.0) print*,'enregistrement tabU'
- call tab_write_ne(Une,'tabU.out',ns1ne,ns2ne,ns3ne)
- if (rank.eq.0) print*,'enregistrement tabV'
- call tab_write_ne(Vne,'tabV.out',ns1ne,ns2ne,ns3ne)
- if (rank.eq.0) print*,'enregistrement tabW'
- call tab_write_ne(Wne,'tabW.out',ns1ne,ns2ne,ns3ne)
- if (rank.eq.0) print*,'enregistrement tabZ'
- call tab_write_ne(Zne,'tabZ.out',ns1ne,ns2ne,ns3ne)
-
- deallocate(Une)
- deallocate(Vne)
- deallocate(Wne)
- deallocate(Zne)
-
-end subroutine postprocess6
diff --git a/Code_LEGI/postprocess7.f90 b/Code_LEGI/postprocess7.f90
deleted file mode 100755
index 42946de56eb4b39b7c816ca8a602b5f3a3dc5ecd..0000000000000000000000000000000000000000
--- a/Code_LEGI/postprocess7.f90
+++ /dev/null
@@ -1,156 +0,0 @@
-subroutine postprocess7
-
- use solver
- use parallel
- use data
-
- implicit none
- integer :: i,j,k,pas,ns1ne,ns2ne,ns3ne
- character(len=30) :: Filename
- integer :: ierr,ik,il,jl,kl,iunit
-
- real(WP), dimension(:), pointer :: xx,pdf
- real(WP), dimension(:,:,:), pointer :: convU, convV, convW
- real(WP), dimension(:,:,:), pointer :: Us1, Vs1, Ws1 , norme
- real(WP), dimension(:,:,:), pointer :: dudx, dudy, dudz
- real(WP), dimension(:,:,:), pointer :: dvdx, dvdy, dvdz
- real(WP), dimension(:,:,:), pointer :: dwdx, dwdy, dwdz
- integer :: dime
-
- dime = 200
-
- !! STEP 1
- call solver_step
- call dns_stats
- if (rank.eq.0) print*,'STEP 1'
- allocate(Us1(ns1,ns2,ns3))
- allocate(Vs1(ns1,ns2,ns3))
- allocate(Ws1(ns1,ns2,ns3))
- Us1 = U
- Vs1 = V
- Ws1 = W
-
- ! STEP 2
- if (rank.eq.0) print*,'STEP 2'
- call solver_step
- call dns_stats
- allocate(dudx(ns1,ns2,ns3))
- allocate(dudy(ns1,ns2,ns3))
- allocate(dudz(ns1,ns2,ns3))
- allocate(dvdx(ns1,ns2,ns3))
- allocate(dvdy(ns1,ns2,ns3))
- allocate(dvdz(ns1,ns2,ns3))
- allocate(dwdx(ns1,ns2,ns3))
- allocate(dwdy(ns1,ns2,ns3))
- allocate(dwdz(ns1,ns2,ns3))
-
- if (rank.eq.0) print*,'comput tab'
- call gradient(U,0.,dudx,dudy,dudz)
- call gradient(V,0.,dvdx,dvdy,dvdz)
- call gradient(W,0.,dwdx,dwdy,dwdz)
-
- if (rank.eq.0) print*,'comput conv term'
- allocate(convU(ns1,ns2,ns3))
- allocate(convV(ns1,ns2,ns3))
- allocate(convW(ns1,ns2,ns3))
- convU = U*dudx + V*dudy + W*dudz
- convV = U*dvdx + V*dvdy + W*dvdz
- convW = U*dwdx + V*dwdy + W*dwdz
- deallocate(dudx)
- deallocate(dudy)
- deallocate(dudz)
- deallocate(dvdx)
- deallocate(dvdy)
- deallocate(dvdz)
- deallocate(dwdx)
- deallocate(dwdy)
- deallocate(dwdz)
-
- !! STEP 3
- if (rank.eq.0) print*,'STEP 3'
- call solver_step
- call dns_stats
-
-
- if (rank.eq.0) print*,'acceleration term, dt =', dt
-
- Us1 = (U - Us1) / (2*dt) + convU
- Vs1 = (V - Vs1) / (2*dt) + convV
- Ws1 = (W - Ws1) / (2*dt) + convW
-
- if (rank.eq.0) print*,'norme'
- allocate(norme(ns1,ns2,ns3))
- norme = (Us1*Us1 + Vs1*Vs1 + Ws1*Ws1)**(0.5)
-
- deallocate(convU)
- deallocate(convV)
- deallocate(convW)
-
- if (rank.eq.0) print*,'PDF'
- allocate(xx(dime))
- allocate(pdf(dime))
- write(FileName,'(A,I2.2,A)') 'pdf_U'
- call c_pdf(xx,pdf,Us1,dime)
- if(rank.eq.0) then
- open(14,file=Filename,form='formatted')
- do i=1,dime-1
- write(14,*) xx(i), pdf(i)
- enddo
- close(14)
- endif
- write(FileName,'(A,I2.2,A)') 'pdf_V'
- call c_pdf(xx,pdf,Vs1,dime)
- if(rank.eq.0) then
- open(14,file=Filename,form='formatted')
- do i=1,dime-1
- write(14,*) xx(i), pdf(i)
- enddo
- close(14)
- endif
- write(FileName,'(A,I2.2,A)') 'pdf_W'
- call c_pdf(xx,pdf,Ws1,dime)
- if(rank.eq.0) then
- open(14,file=Filename,form='formatted')
- do i=1,dime-1
- write(14,*) xx(i), pdf(i)
- enddo
- close(14)
- endif
- write(FileName,'(A,I2.2,A)') 'pdf_nor'
- call c_pdf(xx,pdf,norme,dime)
- if(rank.eq.0) then
- open(14,file=Filename,form='formatted')
- do i=1,dime-1
- write(14,*) xx(i), pdf(i)
- enddo
- close(14)
- endif
- deallocate(xx)
- deallocate(pdf)
-
- if (rank.eq.0) print*,'PARAVIEW'
- call dump_data(Us1,'paravie_acc_1')
- call dump_data(Vs1,'paravie_acc_2')
- call dump_data(Ws1,'paravie_acc_3')
- call dump_data(norme,'paravie_acc_n')
-
- if( rank.eq.0 ) print*,Us1(1,1,1)
- if( rank.eq.nproc-1 ) print*,Us1(ns1,ns2,ns3)
- call tab_write_ne(Us1,'tabaccU.out',ns1,ns2,ns3)
- if( rank.eq.0 ) print*,Vs1(1,1,1)
- if( rank.eq.nproc-1 ) print*,Vs1(ns1,ns2,ns3)
- call tab_write_ne(Vs1,'tabaccV.out',ns1,ns2,ns3)
- if( rank.eq.0 ) print*,Ws1(1,1,1)
- if( rank.eq.nproc-1 ) print*,Ws1(ns1,ns2,ns3)
- call tab_write_ne(Ws1,'tabaccW.out',ns1,ns2,ns3)
- if( rank.eq.0 ) print*,norme(1,1,1)
- if( rank.eq.nproc-1 ) print*,norme(ns1,ns2,ns3)
- call tab_write_ne(norme,'tabaccnorme.out',ns1,ns2,ns3)
-
-
- deallocate(norme)
- deallocate(Us1)
- deallocate(Vs1)
- deallocate(Ws1)
-
-end subroutine postprocess7
diff --git a/Code_LEGI/postprocessparaview.f90 b/Code_LEGI/postprocessparaview.f90
deleted file mode 100755
index 67fc80a1369363f7e7529479138d7e3d3f7531c6..0000000000000000000000000000000000000000
--- a/Code_LEGI/postprocessparaview.f90
+++ /dev/null
@@ -1,338 +0,0 @@
-subroutine dump_data(scalar,name)
-
- use solver
- use parallel
- use data
-
- implicit none
-
- real(WP), dimension(ns1,ns2,ns3) :: scalar
- character(len=13) :: name
- character(len=80) :: buffer
- integer :: iunit,ierr,size,ibuffer, k, kp
- integer :: fileview,datasize,gdatasize
- integer, dimension(MPI_STATUS_SIZE) :: status
- integer(kind=MPI_OFFSET_KIND) :: disp
- integer :: gsizes(3),lsizes(3),start(3)
- real(SP), dimension(:,:,:), pointer :: tab
-
- call MPI_FILE_OPEN(MPI_COMM_WORLD,trim(name),MPI_MODE_WRONLY+MPI_MODE_CREATE,MPI_INFO_NULL,iunit,ierr)
-
- if (rank.eq.0) then
- buffer = trim(name)
- size = 80
- call MPI_FILE_WRITE(iunit,buffer,size,MPI_CHARACTER,status,ierr)
- buffer = 'part'
- size = 80
- call MPI_FILE_WRITE(iunit,buffer,size,MPI_CHARACTER,status,ierr)
- ibuffer = 1
- size = 1
- call MPI_FILE_WRITE(iunit,ibuffer,size,MPI_INTEGER,status,ierr)
- buffer = 'block'
- size = 80
- call MPI_FILE_WRITE(iunit,buffer,size,MPI_CHARACTER,status,ierr)
- end if
-
-
- ! Create the view
- gsizes(1) = nx
- gsizes(2) = nx
- gsizes(3) = nx
- lsizes(1) = ns1
- lsizes(2) = ns2
- lsizes(3) = ns3
- start(1) = nxs - 1
- start(2) = nys - 1
- start(3) = nzs - 1
- datasize = lsizes(1)*lsizes(2)*lsizes(3)
- gdatasize= gsizes(1)*gsizes(2)*gsizes(3)
-
- call MPI_TYPE_CREATE_SUBARRAY(3,gsizes,lsizes,start,MPI_ORDER_FORTRAN,MPI_REAL,fileview,ierr)
- call MPI_TYPE_COMMIT(fileview,ierr)
-
- disp = 3*80+4
- allocate(tab(1:nx,1:nx,nzs:nze))
- do k = 1,ns3
- kp = k + rank*ns3
- tab(:,:,kp) = scalar(:,:,k)
- end do
- call MPI_FILE_SET_VIEW(iunit,disp,MPI_REAL,fileview,"native",MPI_INFO_NULL,ierr)
- call MPI_FILE_WRITE_ALL(iunit,tab,datasize,MPI_REAL,status,ierr)
-
- call MPI_FILE_CLOSE(iunit,ierr)
-
-end subroutine dump_data
-
-subroutine dump_geometry
-
- use solver
- use parallel
- use data
-
- implicit none
-
- integer :: ierr,ipart,iunit,i,j,k
- character(len=80) :: buffer
- real(SP), dimension(:,:,:), pointer :: xbuf,ybuf,zbuf
- integer, dimension(:,:,:), pointer :: iblank
- real(SP) :: max_x,max_y,max_z
- real(SP) :: min_x,min_y,min_z
-
- allocate(xbuf(1:nx+1,1:nx+1,1:nx+1),ybuf(1:nx+1,1:nx+1,1:nx+1),zbuf(1:nx+1,1:nx+1,1:nx+1))
- do i=1,nx+1
- do j=1,ny+1
- do k=1,nz+1
- xbuf(i,j,k)= (real(i)-1.5)*L/real(nx)
- ybuf(i,j,k)= (real(j)-1.5)*L/real(nx)
- zbuf(i,j,k)= (real(k)-1.5)*L/real(nx)
- end do
- end do
- end do
- max_x = maxval(xbuf)
- max_y = maxval(ybuf)
- max_z = maxval(zbuf)
- min_x = minval(xbuf)
- min_y = minval(ybuf)
- min_z = minval(zbuf)
-
- ! Open the file
- !call BINARY_FILE_OPEN(12345,"geometry","w",ierr)
- OPEN(UNIT=12345, FILE='geometry', FORM='unformatted',access='stream')
- REWIND(12345)
-
- ! Write the geometry
- buffer = 'C Binary'
- !call BINARY_FILE_WRITE(12345,buffer,80,kind(buffer),ierr)
- write(12345) buffer
-
- buffer = 'Ensight Gold Geometry File'
- !call BINARY_FILE_WRITE(12345,buffer,80,kind(buffer),ierr)
- write(12345) buffer
-
- buffer = 'Structured Geometry from ARTS'
- !call BINARY_FILE_WRITE(12345,buffer,80,kind(buffer),ierr)
- write(12345) buffer
-
- buffer = 'node id off'
- !call BINARY_FILE_WRITE(12345,buffer,80,kind(buffer),ierr)
- write(12345) buffer
-
- buffer = 'element id off'
- !call BINARY_FILE_WRITE(12345,buffer,80,kind(buffer),ierr)
- write(12345) buffer
-
- buffer = 'part'
- !call BINARY_FILE_WRITE(12345,buffer,80,kind(buffer),ierr)
- write(12345) buffer
-
- ipart = 1
- !call BINARY_FILE_WRITE(12345,ipart,1,kind(ipart),ierr)
- write(12345) ipart
-
- buffer = 'Complete geometry'
- !call BINARY_FILE_WRITE(12345,buffer,80,kind(buffer),ierr)
- write(12345) buffer
-
- buffer = 'block curvilinear iblanked'
- !call BINARY_FILE_WRITE(12345,buffer,80,kind(buffer),ierr)
- write(12345) buffer
-
- !call BINARY_FILE_WRITE(12345,nx+1,1,kind(nx),ierr)
- !call BINARY_FILE_WRITE(12345,ny+1,1,kind(ny),ierr)
- !call BINARY_FILE_WRITE(12345,nz+1,1,kind(nz),ierr)
- write(12345) nx+1
- write(12345) ny+1
- write(12345) nz+1
-
-
- !call BINARY_FILE_WRITE(12345,xbuf,(nx+1)*(ny+1)*(nz+1),kind(xbuf),ierr)
- !call BINARY_FILE_WRITE(12345,ybuf,(nx+1)*(ny+1)*(nz+1),kind(ybuf),ierr)
- !call BINARY_FILE_WRITE(12345,zbuf,(nx+1)*(ny+1)*(nz+1),kind(zbuf),ierr)
- write(12345) xbuf
- write(12345) ybuf
- write(12345) zbuf
-
- ! Get the iblank in 3D
- allocate(iblank(nx+1,ny+1,nz+1))
- do k=1,nz+1
- iblank(1:nx+1,1:ny+1,k) = 1
- end do
- !call BINARY_FILE_WRITE(12345,iblank,(nx+1)*(ny+1)*(nz+1),kind(iblank),ierr)
- write(12345) iblank
-
- ! Close the file
- !call BINARY_FILE_CLOSE(12345,ierr)
- CLOSE(12345)
-
-end subroutine dump_geometry
-
-subroutine dump_geometry_scalar
-
- use solver
- use parallel
- use data
-
- implicit none
-
- integer :: ierr,ipart,iunit,i,j,k
- character(len=80) :: buffer
- real(SP), dimension(:,:,:), pointer :: xbuf,ybuf,zbuf
- integer, dimension(:,:,:), pointer :: iblank
- real(SP) :: max_x,max_y,max_z
- real(SP) :: min_x,min_y,min_z
-
- allocate(xbuf(1:nxsc+1,1:nxsc+1,1:nxsc+1),ybuf(1:nxsc+1,1:nxsc+1,1:nxsc+1),zbuf(1:nxsc+1,1:nxsc+1,1:nxsc+1))
- do i=1,nxsc+1
- do j=1,nysc+1
- do k=1,nzsc+1
- xbuf(i,j,k)= (real(i)-1.5)*L/real(nxsc)
- ybuf(i,j,k)= (real(j)-1.5)*L/real(nxsc)
- zbuf(i,j,k)= (real(k)-1.5)*L/real(nxsc)
- end do
- end do
- end do
- max_x = maxval(xbuf)
- max_y = maxval(ybuf)
- max_z = maxval(zbuf)
- min_x = minval(xbuf)
- min_y = minval(ybuf)
- min_z = minval(zbuf)
-
- print*,"j'y passe"
-
- ! Open the file
- !call BINARY_FILE_OPEN(12345,"geomesca","w",ierr)
- OPEN(UNIT=12345, FILE='geomesca', FORM='unformatted',access='stream')
- REWIND(12345)
-
- ! Write the geometry
- buffer = 'C Binary'
- !call BINARY_FILE_WRITE(12345,buffer,80,kind(buffer),ierr)
- write(12345) buffer
-
- buffer = 'Ensight Gold Geometry File'
- !call BINARY_FILE_WRITE(12345,buffer,80,kind(buffer),ierr)
- write(12345) buffer
-
- buffer = 'Structured Geometry from ARTS'
- !call BINARY_FILE_WRITE(12345,buffer,80,kind(buffer),ierr)
- write(12345) buffer
-
- buffer = 'node id off'
- !call BINARY_FILE_WRITE(12345,buffer,80,kind(buffer),ierr)
- write(12345) buffer
-
- buffer = 'element id off'
- !call BINARY_FILE_WRITE(12345,buffer,80,kind(buffer),ierr)
- write(12345) buffer
-
- buffer = 'part'
- !call BINARY_FILE_WRITE(12345,buffer,80,kind(buffer),ierr)
- write(12345) buffer
-
- ipart = 1
- !call BINARY_FILE_WRITE(12345,ipart,1,kind(ipart),ierr)
- write(12345) ipart
-
- buffer = 'Complete geometry'
- !call BINARY_FILE_WRITE(12345,buffer,80,kind(buffer),ierr)
- write(12345) buffer
-
- buffer = 'block curvilinear iblanked'
- !call BINARY_FILE_WRITE(12345,buffer,80,kind(buffer),ierr)
- write(12345) buffer
-
- !call BINARY_FILE_WRITE(12345,nxsc+1,1,kind(nxsc),ierr)
- !call BINARY_FILE_WRITE(12345,nysc+1,1,kind(nysc),ierr)
- !call BINARY_FILE_WRITE(12345,nzsc+1,1,kind(nzsc),ierr)
- write(12345) nxsc+1
- write(12345) nysc+1
- write(12345) nzsc+1
-
-
- !call BINARY_FILE_WRITE(12345,xbuf,2*(nysc+1)*(nzsc+1),kind(xbuf),ierr)
- !call BINARY_FILE_WRITE(12345,ybuf,2*(nysc+1)*(nzsc+1),kind(ybuf),ierr)
- !call BINARY_FILE_WRITE(12345,zbuf,2*(nysc+1)*(nzsc+1),kind(zbuf),ierr)
- write(12345) xbuf
- write(12345) ybuf
- write(12345) zbuf
-
- ! Get the iblank in 3D
- allocate(iblank(nxsc+1,nysc+1,nzsc+1))
- do k=1,nzsc+1
- iblank(1:nxsc+1,1:nysc+1,k) = 1
- end do
- !call BINARY_FILE_WRITE(12345,iblank,(nxsc+1)*(nysc+1)*(nzsc+1),kind(iblank),ierr)
- write(12345) iblank
-
- ! Close the file
- !call BINARY_FILE_CLOSE(12345,ierr)
- CLOSE(12345)
-
-end subroutine dump_geometry_scalar
-
-
-subroutine dump_data_sc(scalar,name)
-
- use solver
- use parallel
- use data
-
- implicit none
-
- real(WP), dimension(ns1sc,ns2sc,ns3sc) :: scalar
- character(len=13) :: name
- character(len=80) :: buffer
- integer :: iunit,ierr,size,ibuffer, k, kp
- integer :: fileview,datasize,gdatasize
- integer, dimension(MPI_STATUS_SIZE) :: status
- integer(kind=MPI_OFFSET_KIND) :: disp
- integer :: gsizes(3),lsizes(3),start(3)
- real(SP), dimension(:,:,:), pointer :: tab
-
- call MPI_FILE_OPEN(MPI_COMM_WORLD,trim(name),MPI_MODE_WRONLY+MPI_MODE_CREATE,MPI_INFO_NULL,iunit,ierr)
-
- if (rank.eq.0) then
- buffer = trim(name)
- size = 80
- call MPI_FILE_WRITE(iunit,buffer,size,MPI_CHARACTER,status,ierr)
- buffer = 'part'
- size = 80
- call MPI_FILE_WRITE(iunit,buffer,size,MPI_CHARACTER,status,ierr)
- ibuffer = 1
- size = 1
- call MPI_FILE_WRITE(iunit,ibuffer,size,MPI_INTEGER,status,ierr)
- buffer = 'block'
- size = 80
- call MPI_FILE_WRITE(iunit,buffer,size,MPI_CHARACTER,status,ierr)
- end if
-
-
- ! Create the view
- gsizes(1) = nxsc
- gsizes(2) = nxsc
- gsizes(3) = nxsc
- lsizes(1) = ns1sc
- lsizes(2) = ns2sc
- lsizes(3) = ns3sc
- start(1) = nxssc - 1
- start(2) = nyssc - 1
- start(3) = nzssc - 1
- datasize = lsizes(1)*lsizes(2)*lsizes(3)
- gdatasize= gsizes(1)*gsizes(2)*gsizes(3)
-
- call MPI_TYPE_CREATE_SUBARRAY(3,gsizes,lsizes,start,MPI_ORDER_FORTRAN,MPI_REAL,fileview,ierr)
- call MPI_TYPE_COMMIT(fileview,ierr)
-
- disp = 3*80+4
- allocate(tab(1:nxsc,1:nxsc,nzssc:nzesc))
- do k = 1,ns3sc
- kp = k + rank*ns3sc
- tab(:,:,kp) = scalar(:,:,k)
- end do
- call MPI_FILE_SET_VIEW(iunit,disp,MPI_REAL,fileview,"native",MPI_INFO_NULL,ierr)
- call MPI_FILE_WRITE_ALL(iunit,tab,datasize,MPI_REAL,status,ierr)
-
- call MPI_FILE_CLOSE(iunit,ierr)
-
-end subroutine dump_data_sc
diff --git a/Code_LEGI/postprocesstools.f90 b/Code_LEGI/postprocesstools.f90
deleted file mode 100755
index 7a5710b719f3784cadc3ab6852c3b2130c0599a4..0000000000000000000000000000000000000000
--- a/Code_LEGI/postprocesstools.f90
+++ /dev/null
@@ -1,1480 +0,0 @@
-subroutine cc_pdf(xx,pdf,z,in2,value,dime)
- use solver
- use parallel
- use data
- implicit none
- integer :: dime,i,j,k,ll,ierr
- real(WP) :: z(ns1,ns2,ns3),umin,umax,umin_recv,umax_recv,delta
- integer :: in2(ns1,ns2,ns3), value, cpt2, cptt
- real(WP) :: xx(dime), pdf(dime), pdfloc(dime)
-
-
- umin=1.d33
- umax=-1.d33
-
- Do k =1,ns3
- Do j = 1,ns2
- Do i=1,ns1
- if (in2(i,j,k).eq.value) then
- umax = max(umax,z(i,j,k))
- umin = min(umin,z(i,j,k))
- end if
- End Do
- End Do
- End Do
-
- !umax = 5
- !umin = -5
-
- Call MPI_ALLREDUCE(umin, umin_recv, 1, MPI_REAL_WP,MPI_MIN, MPI_COMM_WORLD, ierr)
- umin = umin_recv
- Call MPI_ALLREDUCE(umax, umax_recv, 1, MPI_REAL_WP,MPI_MAX, MPI_COMM_WORLD, ierr)
- umax = umax_recv
-
- pdfloc(:)=0.0
- cptt = 0
- delta=(umax-umin)/(dime-1.)
- if(rank.eq.0) print*,delta,umin,umax
- do ll = 1,dime-1
- do k = 1,ns3
- do j = 1,ns2
- do i = 1,ns1
- if (in2(i,j,k).eq.value) then
- if (z(i,j,k) .gt. umin+(ll-1)*delta ) then
- if (z(i,j,k) .le. umin+ll*delta ) then
- pdfloc(ll)=pdfloc(ll)+1.
- cptt = cptt+1
- end if
- end if
- endif
- enddo
- enddo
- enddo
- xx(ll)=umin+(ll-0.5)*delta
- enddo
- call MPI_ALLREDUCE(pdfloc,pdf,dime,MPI_REAL_WP,MPI_SUM, &
- & MPI_COMM_WORLD,ierr)
- call MPI_ALLREDUCE(cptt,cpt2,1,MPI_INTEGER,MPI_SUM, &
- & MPI_COMM_WORLD,ierr)
- pdf=pdf/(delta*real(cpt2))
-end subroutine cc_pdf
-
-subroutine c_pdf_sca(xx,pdf,z,dime)
- use solver
- use parallel
- use data
- implicit none
- integer :: dime,i,j,k,ll,ierr, cpt2, cptt
- real(WP) :: z(ns1sc,ns2sc,ns3sc),umin,umax,umin_recv,umax_recv,delta
- real(WP) :: xx(dime), pdf(dime), pdfloc(dime)
-
-
- umin=1.d33
- umax=-1.d33
-
- Do k =1,ns3sc
- Do j = 1,ns2sc
- Do i=1,ns1sc
- umax = max(umax,z(i,j,k))
- umin = min(umin,z(i,j,k))
- End Do
- End Do
- End Do
-
- Call MPI_ALLREDUCE(umin, umin_recv, 1, MPI_REAL_WP,MPI_MIN, MPI_COMM_WORLD, ierr)
- umin = umin_recv
- Call MPI_ALLREDUCE(umax, umax_recv, 1, MPI_REAL_WP,MPI_MAX, MPI_COMM_WORLD, ierr)
- umax = umax_recv
-
- pdfloc(:)=0.0
- cptt = 0
- delta=(umax-umin)/(dime-1.)
- if(rank.eq.0) print*,delta,umin,umax
- do ll = 1,dime-1
- do k = 1,ns3sc
- do j = 1,ns2sc
- do i = 1,ns1sc
- if( z(i,j,k) .gt. umin+(ll-1)*delta ) then
- if( z(i,j,k) .le. umin+ll*delta ) then
- pdfloc(ll)=pdfloc(ll)+1.
- cptt = cptt + 1
- endif
- endif
- enddo
- enddo
- enddo
- xx(ll)=umin+(ll-0.5)*delta
- enddo
- call MPI_ALLREDUCE(pdfloc,pdf,dime,MPI_REAL_WP,MPI_SUM, &
- & MPI_COMM_WORLD,ierr)
- call MPI_ALLREDUCE(cptt,cpt2,1,MPI_INTEGER,MPI_SUM, &
- & MPI_COMM_WORLD,ierr)
- pdf=pdf/(delta*real(cpt2))
-end subroutine c_pdf_sca
-
-subroutine c_pdf_sca_fix(xx,pdf,z,dime,mini,maxi)
- use solver
- use parallel
- use data
- implicit none
- integer :: dime,i,j,k,ll,ierr, cpt2, cptt
- real(WP) :: z(ns1sc,ns2sc,ns3sc),umin,umax,umin_recv,umax_recv,delta,mini,maxi
- real(WP) :: xx(dime), pdf(dime), pdfloc(dime)
-
-
- umin = mini
- umax = maxi
-
- pdfloc(:)=0.0
- cptt = 0
- delta=(umax-umin)/(dime-1.)
- if(rank.eq.0) print*,delta,umin,umax
- do ll = 1,dime-1
- do k = 1,ns3sc
- do j = 1,ns2sc
- do i = 1,ns1sc
- if( z(i,j,k) .gt. umin+(ll-1)*delta ) then
- if( z(i,j,k) .le. umin+ll*delta ) then
- pdfloc(ll)=pdfloc(ll)+1.
- cptt = cptt + 1
- endif
- endif
- enddo
- enddo
- enddo
- xx(ll)=umin+(ll-0.5)*delta
- enddo
- call MPI_ALLREDUCE(pdfloc,pdf,dime,MPI_REAL_WP,MPI_SUM, &
- & MPI_COMM_WORLD,ierr)
- call MPI_ALLREDUCE(cptt,cpt2,1,MPI_INTEGER,MPI_SUM, &
- & MPI_COMM_WORLD,ierr)
-! pdf=pdf/(delta*real(cpt2))
- if(rank.eq.0) print*,'nombre de point dans la pdf avec min =',mini, &
- & ' et max =',maxi, ": ", real(cpt2)/ns1sc**3.*100.," pourcent de points"
-end subroutine c_pdf_sca_fix
-
-subroutine c_pdf(xx,pdf,z,dime)
- use solver
- use parallel
- use data
- implicit none
- integer :: dime,i,j,k,ll,ierr, cpt2, cptt
- real(WP) :: z(ns1,ns2,ns3),umin,umax,umin_recv,umax_recv,delta
- real(WP) :: xx(dime), pdf(dime), pdfloc(dime)
-
-
- umin=1.d33
- umax=-1.d33
-
- Do k =1,ns3
- Do j = 1,ns2
- Do i=1,ns1
- umax = max(umax,z(i,j,k))
- umin = min(umin,z(i,j,k))
- End Do
- End Do
- End Do
-
- Call MPI_ALLREDUCE(umin, umin_recv, 1, MPI_REAL_WP,MPI_MIN, MPI_COMM_WORLD, ierr)
- umin = umin_recv
- Call MPI_ALLREDUCE(umax, umax_recv, 1, MPI_REAL_WP,MPI_MAX, MPI_COMM_WORLD, ierr)
- umax = umax_recv
-
- pdfloc(:)=0.0
- cptt = 0
- delta=(umax-umin)/(dime-1.)
- if(rank.eq.0) print*,delta,umin,umax
- do ll = 1,dime-1
- do k = 1,ns3
- do j = 1,ns2
- do i = 1,ns1
- if( z(i,j,k) .gt. umin+(ll-1)*delta ) then
- if( z(i,j,k) .le. umin+ll*delta ) then
- pdfloc(ll)=pdfloc(ll)+1.
- cptt = cptt + 1
- endif
- endif
- enddo
- enddo
- enddo
- xx(ll)=umin+(ll-0.5)*delta
- enddo
- call MPI_ALLREDUCE(pdfloc,pdf,dime,MPI_REAL_WP,MPI_SUM, &
- & MPI_COMM_WORLD,ierr)
- call MPI_ALLREDUCE(cptt,cpt2,1,MPI_INTEGER,MPI_SUM, &
- & MPI_COMM_WORLD,ierr)
- pdf=pdf/(delta*real(cpt2))
-end subroutine c_pdf
-
-subroutine cn_pdf(xx,pdf,z,dnsdiss,dime)
- use solver
- use parallel
- use data
- implicit none
- integer :: dime,i,j,k,ll,ierr
- real(WP) :: dnsdiss(ns1,ns2,ns3),z(ns1,ns2,ns3),umin,umax,umin_recv,umax_recv,delta,cptt
- real(WP) :: xx(dime), pdf(dime), pdfloc(dime)
-
-
- umin=1.d33
- umax=-1.d33
-
- Do k =1,ns3
- Do j = 1,ns2
- Do i=1,ns1
- if (dnsdiss(i,j,k).le.0) then
- umax = max(umax,z(i,j,k))
- umin = min(umin,z(i,j,k))
- end if
- End Do
- End Do
- End Do
-
- Call MPI_ALLREDUCE(umin, umin_recv, 1, MPI_REAL_WP,MPI_MIN, MPI_COMM_WORLD, ierr)
- umin = umin_recv
- Call MPI_ALLREDUCE(umax, umax_recv, 1, MPI_REAL_WP,MPI_MAX, MPI_COMM_WORLD, ierr)
- umax = umax_recv
-
- umax = 10.
- umin = -10.
-
- pdfloc(:)=0.0
- cptt = 0
- delta=(umax-umin)/(dime-1.)
- if(rank.eq.0) print*,delta,umin,umax
- do ll = 1,dime-1
- do k = 1,ns3
- do j = 1,ns2
- do i = 1,ns1
- if (dnsdiss(i,j,k).le.0) then
- if (z(i,j,k) .gt. umin+(ll-1)*delta ) then
- if (z(i,j,k) .le. umin+ll*delta ) then
- pdfloc(ll)=pdfloc(ll)+1.
- cptt = cptt + 1
- endif
- endif
- endif
- enddo
- enddo
- enddo
- xx(ll)=umin+(ll-0.5)*delta
- enddo
- call MPI_ALLREDUCE(pdfloc,pdf,dime,MPI_REAL_WP,MPI_SUM, &
- & MPI_COMM_WORLD,ierr)
- pdf=pdf/(delta*real(cptt))
-end subroutine cn_pdf
-
-subroutine cp_pdf(xx,pdf,z,dnsdiss,dime)
- use solver
- use parallel
- use data
- implicit none
- integer :: dime,i,j,k,ll,ierr
- real(WP) :: dnsdiss(ns1,ns2,ns3),z(ns1,ns2,ns3),umin,umax,umin_recv,umax_recv,delta,cptt
- real(WP) :: xx(dime), pdf(dime), pdfloc(dime)
-
-
- umin=1.d33
- umax=-1.d33
-
- Do k =1,ns3
- Do j = 1,ns2
- Do i=1,ns1
- if (dnsdiss(i,j,k).gt.0) then
- umax = max(umax,z(i,j,k))
- umin = min(umin,z(i,j,k))
- end if
- End Do
- End Do
- End Do
-
- Call MPI_ALLREDUCE(umin, umin_recv, 1, MPI_REAL_WP,MPI_MIN, MPI_COMM_WORLD, ierr)
- umin = umin_recv
- Call MPI_ALLREDUCE(umax, umax_recv, 1, MPI_REAL_WP,MPI_MAX, MPI_COMM_WORLD, ierr)
- umax = umax_recv
-
- umax = 10.
- umin = -10.
-
- pdfloc(:)=0.0
- cptt = 0
- delta=(umax-umin)/(dime-1.)
- if(rank.eq.0) print*,delta,umin,umax
- do ll = 1,dime-1
- do k = 1,ns3
- do j = 1,ns2
- do i = 1,ns1
- if (dnsdiss(i,j,k).gt.0) then
- if (z(i,j,k) .gt. umin+(ll-1)*delta ) then
- if (z(i,j,k) .le. umin+ll*delta ) then
- pdfloc(ll)=pdfloc(ll)+1.
- cptt = cptt + 1
- endif
- endif
- endif
- enddo
- enddo
- enddo
- xx(ll)=umin+(ll-0.5)*delta
- enddo
- call MPI_ALLREDUCE(pdfloc,pdf,dime,MPI_REAL_WP,MPI_SUM, &
- & MPI_COMM_WORLD,ierr)
- pdf=pdf/(delta*real(cpTt))
-end subroutine cp_pdf
-
-subroutine var_skew_fla(z,vv,s,f)
- use solver
- use parallel
- use data
- implicit none
- real(WP) :: z(ns1,ns2,ns3)
- real(WP) :: test(ns1,ns2,ns3)
- real(WP) :: vv,s,f, buf1, buf2, buf3, buf4
-
- call moyen(z,buf1)
- call moyen(z**2,buf2)
- vv = buf2-buf1**2
- test = (z-buf1)**3
- call moyen(test,buf3)
- test = (z-buf1)**4
- call moyen(test,buf4)
- s = buf3 / (buf2**(3./2.))
- f = buf4 / (buf2**(2.))
-end subroutine var_skew_fla
-
-subroutine corre(tab1,tab2,cor)
- use solver
- use parallel
- use data
- implicit none
- real(WP) :: cor,moya,moyb
- real(WP) :: varab,vara2,varb2
- real(WP) :: tab1(ns1,ns2,ns3)
- real(WP) :: tab2(ns1,ns2,ns3)
- call moyen(tab1,moya)
- call moyen(tab2,moyb)
- call moyen(tab1*tab2,varab)
- varab = varab - moya*moyb
- call moyen(tab1*tab1,vara2)
- vara2 = vara2 - moya*moya
- call moyen(tab2*tab2,varb2)
- varb2 = varb2 - moyb*moyb
- cor=varab/(sqrt(vara2*varb2));
-end subroutine corre
-
-subroutine moyen_reg1(in1,in2,out1,value)
- use solver
- use parallel
- use data
- implicit none
- real(WP) :: out1,out2
- real(WP) :: in1(ns1,ns2,ns3)
- integer :: in2(ns1,ns2,ns3)
- integer :: i,j,k,ierr, value, cptt, cpt2
- out2 =0.
- cpt2 = 0
- do k = 1,ns3
- do j = 1,ns2
- do i = 1,ns1
- if (in2(i,j,k).eq.value) then
- out2=out2+in1(i,j,k)
- cpt2 = cpt2 + 1
- end if
- enddo
- enddo
- enddo
- call MPI_ALLREDUCE(cpt2,cptt,1,MPI_INTEGER,MPI_SUM, &
- & MPI_COMM_WORLD,ierr)
- call MPI_ALLREDUCE(out2,out1,1,MPI_REAL_WP,MPI_SUM, &
- & MPI_COMM_WORLD,ierr)
- out1=out1/(real(cptt))
-end subroutine moyen_reg1
-
-subroutine moyen_reg2(in1,in2,out1,value)
- use solver
- use parallel
- use data
- implicit none
- real(WP) :: out1,out2
- real(WP) :: in1(ns1,ns2,ns3)
- integer :: in2(ns1,ns2,ns3)
- integer :: i,j,k,ierr, value, cptt, cpt2
- out2 =0.
- cpt2 = 0
- do k = 1,ns3
- do j = 1,ns2
- do i = 1,ns1
- if (in2(i,j,k).eq.value) then
- out2=out2+in1(i,j,k)
- cpt2 = cpt2 + 1
- end if
- enddo
- enddo
- enddo
- call MPI_ALLREDUCE(cpt2,cptt,1,MPI_INTEGER,MPI_SUM, &
- & MPI_COMM_WORLD,ierr)
- call MPI_ALLREDUCE(out2,out1,1,MPI_REAL_WP,MPI_SUM, &
- & MPI_COMM_WORLD,ierr)
- out1=out1/(real(nx**3))
-end subroutine moyen_reg2
-
-subroutine moyensc(in1,out1)
- use solver
- use parallel
- use data
- implicit none
- real(WP) :: out1,out2
- real(WP) :: in1(ns1sc,ns2sc,ns3sc)
- integer i,j,k,ierr
- out2 =0.
- do k = 1,ns3sc
- do j = 1,ns2sc
- do i = 1,ns1sc
- out2=out2+in1(i,j,k)
- enddo
- enddo
- enddo
- call MPI_ALLREDUCE(out2,out1,1,MPI_REAL_WP,MPI_SUM, &
- & MPI_COMM_WORLD,ierr)
- out1=out1/(real(nxsc**3.))
-end subroutine moyensc
-
-subroutine moyen(in1,out1)
- use solver
- use parallel
- use data
- implicit none
- real(WP) :: out1,out2
- real(WP) :: in1(ns1,ns2,ns3)
- integer i,j,k,ierr
- out2 =0.
- do k = 1,ns3
- do j = 1,ns2
- do i = 1,ns1
- out2=out2+in1(i,j,k)
- enddo
- enddo
- enddo
- call MPI_ALLREDUCE(out2,out1,1,MPI_REAL_WP,MPI_SUM, &
- & MPI_COMM_WORLD,ierr)
- out1=out1/(real(nx**3.))
-end subroutine moyen
-
-subroutine moyen_ysc(in1,out1)
- use solver
- use parallel
- use data
- implicit none
- real(WP) :: out1(ns2sc),out2(ns2sc)
- real(WP) :: in1(ns1sc,ns2sc,ns3sc)
- integer i,j,k,ierr
- out2 =0.
- do k = 1,ns3sc
- do j = 1,ns2sc
- do i = 1,ns1sc
- out2(j)=out2(j)+in1(i,j,k)
- enddo
- enddo
- enddo
- call MPI_ALLREDUCE(out2,out1,ns2sc,MPI_REAL_WP,MPI_SUM, &
- & MPI_COMM_WORLD,ierr)
-
- out1=out1/(real(nxsc**2.))
-
-end subroutine moyen_ysc
-
-subroutine moyen_y(in1,out1)
- use solver
- use parallel
- use data
- implicit none
- real(WP) :: out1(ns2),out2(ns2)
- real(WP) :: in1(ns1,ns2,ns3)
- integer i,j,k,ierr
- out2 =0.
- do k = 1,ns3
- do j = 1,ns2
- do i = 1,ns1
- out2(j)=out2(j)+in1(i,j,k)
- enddo
- enddo
- enddo
- call MPI_ALLREDUCE(out2,out1,ns2,MPI_REAL_WP,MPI_SUM, &
- & MPI_COMM_WORLD,ierr)
-
- out1=out1/(real(nx**2.))
-
-end subroutine moyen_y
-
-subroutine mean_cond_2(in,cond,cond2,out,nbr)
- use solver
- use parallel
- use data
- implicit none
- integer :: nbr,i,j,k,jj,kk,ierr
- real(WP) :: minix,maxix,delta
- real(WP) :: minix2,maxix2,delta2
- real(WP) :: minix_recv,maxix_recv,minix2_recv,maxix2_recv
- real(WP) :: value(nbr,nbr),valueloc(nbr,nbr)
- real(WP) :: nombre(nbr,nbr),nombreloc(nbr,nbr)
- real(WP) :: in(ns1,ns2,ns3)
- real(WP) :: cond(ns1,ns2,ns3)
- real(WP) :: cond2(ns1,ns2,ns3)
- real(WP) :: out(ns1,ns2,ns3)
- maxix=-1.d33
- minix=1.d33
- maxix2=-1.d33
- minix2=1.d33
-
- Do k =1,ns3
- Do j = 1,ns2
- Do i=1,ns1
- maxix = max(maxix,cond(i,j,k))
- minix = min(minix,cond(i,j,k))
- maxix2 = max(maxix2,cond2(i,j,k))
- minix2 = min(minix2,cond2(i,j,k))
- End Do
- End Do
- End Do
-
- Call MPI_ALLREDUCE(minix, minix_recv, 1, MPI_REAL_WP,MPI_MIN, MPI_COMM_WORLD, ierr)
- minix = minix_recv
- Call MPI_ALLREDUCE(minix2, minix2_recv, 1, MPI_REAL_WP,MPI_MIN, MPI_COMM_WORLD, ierr)
- minix2 = minix2_recv
- Call MPI_ALLREDUCE(maxix, maxix_recv, 1, MPI_REAL_WP,MPI_MAX, MPI_COMM_WORLD, ierr)
- maxix = maxix_recv
- Call MPI_ALLREDUCE(maxix2, maxix2_recv, 1, MPI_REAL_WP,MPI_MAX, MPI_COMM_WORLD, ierr)
- maxix2 = maxix2_recv
-
- delta = (maxix-minix)/real(nbr);
-
- delta2 = (maxix2-minix2)/real(nbr);
- nombreloc=0.
- valueloc =0.
- do k = 1,ns3
- do j = 1,ns2
- do i = 1,ns1
- do jj = 1,nbr
- do kk = 1,nbr
- if(cond(i,j,k)>minix+(jj-1)*delta.and.cond(i,j,k)<=minix+jj*delta &
- & .and.cond2(i,j,k)>minix2+(kk-1)*delta2.and.cond2(i,j,k)<=minix2+kk*delta2 ) then
- valueloc(jj,kk)=valueloc(jj,kk)+in(i,j,k);
- nombreloc(jj,kk)=nombreloc(jj,kk)+1;
- endif
- enddo
- enddo
- enddo
- enddo
- enddo
- call MPI_ALLREDUCE(valueloc,value,nbr*nbr,MPI_REAL_WP,MPI_SUM, &
- & MPI_COMM_WORLD,ierr)
- call MPI_ALLREDUCE(nombreloc,nombre,nbr*nbr,MPI_REAL_WP,MPI_SUM, &
- & MPI_COMM_WORLD,ierr)
- value=value/nombre
- do k = 1,ns3
- do j = 1,ns2
- do i = 1,ns1
- do jj = 1,nbr
- do kk = 1,nbr
- if(cond(i,j,k)>minix+(jj-1)*delta.and.cond(i,j,k)<=minix+jj*delta &
- & .and.cond2(i,j,k)>minix2+(kk-1)*delta2.and.cond2(i,j,k)<=minix2+kk*delta2 ) then
- out(i,j,k)=value(jj,kk)
- endif
- enddo
- enddo
- enddo
- enddo
- enddo
-end subroutine mean_cond_2
-
-subroutine mean_cond(in,cond,out,xx,value,nbr)
- use solver
- use parallel
- use data
- implicit none
- integer :: nbr,i,j,k,jj,ierr
- real(WP) :: minix,maxix,delta,maxixloc,minixloc
- real(WP) :: value(nbr),valueloc(nbr),xx(nbr)
- real(WP) :: nombre(nbr),nombreloc(nbr)
- real(WP) :: in(ns1,ns2,ns3)
- real(WP) :: cond(ns1,ns2,ns3)
- real(WP) :: out(ns1,ns2,ns3)
- maxixloc = maxval(cond)
- call MPI_ALLREDUCE(maxixloc,maxix,1,MPI_REAL_WP,MPI_MAX, &
- MPI_COMM_WORLD,ierr)
- minixloc = minval(cond)
- call MPI_ALLREDUCE(minixloc,minix,1,MPI_REAL_WP,MPI_MIN, &
- MPI_COMM_WORLD,ierr)
- delta = (maxix-minix)/real(nbr);
-! if(rank.eq.0) print*,maxix
-! if(rank.eq.0) print*,minix
- nombreloc=0.
- valueloc =0.
- do k = 1,ns3
- do j = 1,ns2
- do i = 1,ns1
- do jj = 1,nbr
- if(cond(i,j,k)>minix+(jj-1)*delta.and.cond(i,j,k)<=minix+jj*delta ) then
- valueloc(jj)=valueloc(jj)+in(i,j,k);
- nombreloc(jj)=nombreloc(jj)+1;
- endif
- enddo
- enddo
- enddo
- enddo
- do jj = 1,nbr
- xx(jj) = minix+(jj-0.5)*delta
- enddo
- call MPI_ALLREDUCE(valueloc,value,nbr,MPI_REAL_WP,MPI_SUM, &
- MPI_COMM_WORLD,ierr)
- call MPI_ALLREDUCE(nombreloc,nombre,nbr,MPI_REAL_WP,MPI_SUM, &
- MPI_COMM_WORLD,ierr)
- value=value/nombre
- do k = 1,ns3
- do j = 1,ns2
- do i = 1,ns1
- do jj = 1,nbr
- if(cond(i,j,k)>minix+(jj-1)*delta.and.cond(i,j,k)<=minix+jj*delta ) then
- out(i,j,k)=value(jj)
- endif
- enddo
- enddo
- enddo
- enddo
-end subroutine mean_cond
-
-subroutine physboxfilter(in1,out1,nd)
- use solver
- use parallel
- use data
- implicit none
- real(WP) :: out1(ns1,ns2,ns3)
- real(WP) :: in1(ns1,ns2,ns3)
- real(WP) :: dist,nd
- integer i,j,k,nd2,number
- integer iii,jj,kk
- integer id,jd,kd
-
- nd2=int(nd/2)
- do k=1,ns1
- do j=1,ns1
- do i=1,ns1
- out1(i,j,k)=0
- number=0
- do iii = i-nd2,i+nd2
- do jj = j-nd2,j+nd2
- do kk = k-nd2,k+nd2
- dist = sqrt((real(i)-real(iii))**2.+(real(j)-real(jj))**2.+(real(k)-real(kk))**2.)
-! print*,dist,i,iii,j,jj,k,kk,nd2
- if (dist.le.real(nd2)) then
- if(iii.lt.1) then
- id = ns1+iii
- elseif(iii.gt.ns1) then
- id = iii-ns1
- else
- id = iii
- endif
- if(jj.lt.1) then
- jd = ns1+jj
- elseif(j.gt.ns1) then
- jd = jj-ns1
- else
- jd = jj
- endif
- if(kk.lt.1) then
- kd = ns1+kk
- elseif(kk.gt.ns1) then
- kd = kk-ns1
- else
- kd = kk
- endif
- out1(i,j,k)=out1(i,j,k)+in1(id,jd,kd)
- number=number+1
- endif
- enddo
- enddo
- enddo
- out1(i,j,k) = out1(i,j,k)/number
- enddo
- enddo
- enddo
- print*,'number of points',number
-end subroutine physboxfilter
-
-subroutine specboxfiltersc(in1,out1,nd)
- use solver
- use parallel
- use data
- implicit none
- real(WP) :: kk,delta,nd,dx
- real(WP) :: out1(ns1sc,ns2sc,ns3sc)
- real(WP) :: in1(ns1sc,ns2sc,ns3sc)
- complex(WP), dimension(:,:,:), pointer :: ink
- complex(WP), dimension(:,:,:), pointer :: outk
- integer i,j,k
-
- dx = L/(real(nxsc))
- ALLOCATE(ink(fns1sc,fns2sc,fns3sc))
- ALLOCATE(outk(fns1sc,fns2sc,fns3sc))
- call ftran_wrap(in1,ink,ns1sc,ns2sc,ns3sc,fns1sc,fns2sc,fns3sc)
- ink=ink/(real(ns1sc)**3.)
- delta = nd*dx
- do k = 1,fns3sc
- do j = 1,fns2sc
- do i = 1,fns1sc
- if(kxsc(i).eq.0.and.kysc(j).eq.0.and.kzsc(k).eq.0) then
- outk(i,j,k) = ink(i,j,k)
- elseif(kxsc(i).eq.0.and.kysc(j).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kzsc(k))/(0.5*delta*kzsc(k))
- elseif(kxsc(i).eq.0.and.kzsc(k).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kysc(j))/(0.5*delta*kysc(j))
- elseif(kysc(j).eq.0.and.kzsc(k).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kxsc(i))/(0.5*delta*kxsc(i))
- elseif(kxsc(i).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kysc(j))/(0.5*delta*kysc(j))* &
- & sin(0.5*delta*kzsc(k))/(0.5*delta*kzsc(k))
- elseif(kysc(j).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kxsc(i))/(0.5*delta*kxsc(i))* &
- & sin(0.5*delta*kzsc(k))/(0.5*delta*kzsc(k))
- elseif(kzsc(k).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kxsc(i))/(0.5*delta*kxsc(i))* &
- & sin(0.5*delta*kysc(j))/(0.5*delta*kysc(j))
- else
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kxsc(i))/(0.5*delta*kxsc(i))* &
- & sin(0.5*delta*kysc(j))/(0.5*delta*kysc(j))* &
- & sin(0.5*delta*kzsc(k))/(0.5*delta*kzsc(k))
- endif
- enddo
- enddo
- enddo
- call btran_wrap(outk,out1,ns1sc,ns2sc,ns3sc,fns1sc,fns2sc,fns3sc)
- deallocate(ink)
- deallocate(outk)
-end subroutine specboxfiltersc
-
-subroutine specboxfilter(in1,out1,nd)
- use solver
- use parallel
- use data
- implicit none
- real(WP) :: kk,delta,nd,dx
- real(WP) :: out1(ns1,ns2,ns3)
- real(WP) :: in1(ns1,ns2,ns3)
- complex(WP), dimension(:,:,:), pointer :: ink
- complex(WP), dimension(:,:,:), pointer :: outk
- integer i,j,k
- dx = L/(real(nx))
- ALLOCATE(ink(fns1,fns2,fns3))
- ALLOCATE(outk(fns1,fns2,fns3))
- call ftran_wrap(in1,ink,ns1,ns2,ns3,fns1,fns2,fns3)
- ink=ink/(real(ns1)**3.)
- delta = nd*dx
- do k = 1,fns3
- do j = 1,fns2
- do i = 1,fns1
- if(kx(i).eq.0.and.ky(j).eq.0.and.kz(k).eq.0) then
- outk(i,j,k) = ink(i,j,k)
- elseif(kx(i).eq.0.and.ky(j).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kz(k))/(0.5*delta*kz(k))
- elseif(kx(i).eq.0.and.kz(k).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*ky(j))/(0.5*delta*ky(j))
- elseif(ky(j).eq.0.and.kz(k).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kx(i))/(0.5*delta*kx(i))
- elseif(kx(i).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*ky(j))/(0.5*delta*ky(j))* &
- & sin(0.5*delta*kz(k))/(0.5*delta*kz(k))
- elseif(ky(j).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kx(i))/(0.5*delta*kx(i))* &
- & sin(0.5*delta*kz(k))/(0.5*delta*kz(k))
- elseif(kz(k).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kx(i))/(0.5*delta*kx(i))* &
- & sin(0.5*delta*ky(j))/(0.5*delta*ky(j))
- else
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kx(i))/(0.5*delta*kx(i))* &
- & sin(0.5*delta*ky(j))/(0.5*delta*ky(j))* &
- & sin(0.5*delta*kz(k))/(0.5*delta*kz(k))
- endif
- enddo
- enddo
- enddo
- call btran_wrap(outk,out1,ns1,ns2,ns3,fns1,fns2,fns3)
- deallocate(ink)
- deallocate(outk)
-end subroutine specboxfilter
-
-subroutine speccutboxfilter2sc(in1,out1,nd)
- use solver
- use parallel
- use data
- implicit none
- real(WP) :: kk,delta,nd,dx,kc
- real(WP) :: out1(ns1sc,ns2sc,ns3sc)
- real(WP) :: in1(ns1sc,ns2sc,ns3sc)
- complex(WP), dimension(:,:,:), pointer :: ink
- complex(WP), dimension(:,:,:), pointer :: outk
- integer i,j,k
- dx = L/(real(nx))
- ALLOCATE(ink(fns1sc,fns2sc,fns3sc))
- ALLOCATE(outk(fns1sc,fns2sc,fns3sc))
- call ftran_wrap(in1,ink,ns1sc,ns2sc,ns3sc,fns1sc,fns2sc,fns3sc)
- ink=ink/(real(ns1sc)**3.)
- delta = nd*dx
- kc = 2*3.141592654/delta
- do k = 1,fns3sc
- do j = 1,fns2sc
- do i = 1,fns1sc
- if(kxsc(i).eq.0.and.kysc(j).eq.0.and.kzsc(k).eq.0) then
- outk(i,j,k) = ink(i,j,k)
- elseif(kxsc(i).eq.0.and.kysc(j).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kzsc(k))/(0.5*delta*kzsc(k))
- elseif(kxsc(i).eq.0.and.kzsc(k).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kysc(j))/(0.5*delta*kysc(j))
- elseif(kysc(j).eq.0.and.kzsc(k).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kxsc(i))/(0.5*delta*kxsc(i))
- elseif(kxsc(i).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kysc(j))/(0.5*delta*kysc(j))* &
- & sin(0.5*delta*kzsc(k))/(0.5*delta*kzsc(k))
- elseif(kysc(j).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kxsc(i))/(0.5*delta*kxsc(i))* &
- & sin(0.5*delta*kzsc(k))/(0.5*delta*kzsc(k))
- elseif(kzsc(k).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kxsc(i))/(0.5*delta*kxsc(i))* &
- & sin(0.5*delta*kysc(j))/(0.5*delta*kysc(j))
- else
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kxsc(i))/(0.5*delta*kxsc(i))* &
- & sin(0.5*delta*kysc(j))/(0.5*delta*kysc(j))* &
- & sin(0.5*delta*kzsc(k))/(0.5*delta*kzsc(k))
- endif
- enddo
- enddo
- enddo
- do k = 1,fns3sc
- do j = 1,fns2sc
- do i = 1,fns1sc
- kk = sqrt(kxsc(i)**2 + kysc(j)**2 + kzsc(k)**2)
- if (kk.gt.kc) then
- outk(i,j,k) = 0.0
- end if
- enddo
- enddo
- enddo
- call btran_wrap(outk,out1,ns1sc,ns2sc,ns3sc,fns1sc,fns2sc,fns3sc)
- deallocate(ink)
- deallocate(outk)
-end subroutine speccutboxfilter2sc
-
-subroutine speccutboxfilter2(in1,out1,nd)
- use solver
- use parallel
- use data
- implicit none
- real(WP) :: kk,delta,nd,dx,kc
- real(WP) :: out1(ns1,ns2,ns3)
- real(WP) :: in1(ns1,ns2,ns3)
- complex(WP), dimension(:,:,:), pointer :: ink
- complex(WP), dimension(:,:,:), pointer :: outk
- integer i,j,k
- dx = L/(real(nx))
- ALLOCATE(ink(fns1,fns2,fns3))
- ALLOCATE(outk(fns1,fns2,fns3))
- call ftran_wrap(in1,ink,ns1,ns2,ns3,fns1,fns2,fns3)
- ink=ink/(real(ns1)**3.)
- delta = nd*dx
- kc = 2*3.141592654/delta
- do k = 1,fns3
- do j = 1,fns2
- do i = 1,fns1
- if(kx(i).eq.0.and.ky(j).eq.0.and.kz(k).eq.0) then
- outk(i,j,k) = ink(i,j,k)
- elseif(kx(i).eq.0.and.ky(j).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kz(k))/(0.5*delta*kz(k))
- elseif(kx(i).eq.0.and.kz(k).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*ky(j))/(0.5*delta*ky(j))
- elseif(ky(j).eq.0.and.kz(k).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kx(i))/(0.5*delta*kx(i))
- elseif(kx(i).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*ky(j))/(0.5*delta*ky(j))* &
- & sin(0.5*delta*kz(k))/(0.5*delta*kz(k))
- elseif(ky(j).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kx(i))/(0.5*delta*kx(i))* &
- & sin(0.5*delta*kz(k))/(0.5*delta*kz(k))
- elseif(kz(k).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kx(i))/(0.5*delta*kx(i))* &
- & sin(0.5*delta*ky(j))/(0.5*delta*ky(j))
- else
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kx(i))/(0.5*delta*kx(i))* &
- & sin(0.5*delta*ky(j))/(0.5*delta*ky(j))* &
- & sin(0.5*delta*kz(k))/(0.5*delta*kz(k))
- endif
- enddo
- enddo
- enddo
- do k = 1,fns3
- do j = 1,fns2
- do i = 1,fns1
- kk = sqrt(kx(i)**2 + ky(j)**2 + kz(k)**2)
- if (kk.gt.kc) then
- outk(i,j,k) = 0.0
- end if
- enddo
- enddo
- enddo
- call btran_wrap(outk,out1,ns1,ns2,ns3,fns1,fns2,fns3)
- deallocate(ink)
- deallocate(outk)
-end subroutine speccutboxfilter2
-
-subroutine speccutboxfilter(in1,out1,nd)
- use solver
- use parallel
- use data
- implicit none
- real(WP) :: kk,delta,nd,dx,kc
- real(WP) :: out1(ns1,ns2,ns3)
- real(WP) :: in1(ns1,ns2,ns3)
- complex(WP), dimension(:,:,:), pointer :: ink
- complex(WP), dimension(:,:,:), pointer :: outk
- integer i,j,k
- dx = L/(real(nx))
- ALLOCATE(ink(fns1,fns2,fns3))
- ALLOCATE(outk(fns1,fns2,fns3))
- call ftran_wrap(in1,ink,ns1,ns2,ns3,fns1,fns2,fns3)
- ink=ink/(real(ns1)**3.)
- delta = nd*dx
- kc = 3.141592654/delta
- do k = 1,fns3
- do j = 1,fns2
- do i = 1,fns1
- if(kx(i).eq.0.and.ky(j).eq.0.and.kz(k).eq.0) then
- outk(i,j,k) = ink(i,j,k)
- elseif(kx(i).eq.0.and.ky(j).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kz(k))/(0.5*delta*kz(k))
- elseif(kx(i).eq.0.and.kz(k).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*ky(j))/(0.5*delta*ky(j))
- elseif(ky(j).eq.0.and.kz(k).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kx(i))/(0.5*delta*kx(i))
- elseif(kx(i).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*ky(j))/(0.5*delta*ky(j))* &
- & sin(0.5*delta*kz(k))/(0.5*delta*kz(k))
- elseif(ky(j).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kx(i))/(0.5*delta*kx(i))* &
- & sin(0.5*delta*kz(k))/(0.5*delta*kz(k))
- elseif(kz(k).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kx(i))/(0.5*delta*kx(i))* &
- & sin(0.5*delta*ky(j))/(0.5*delta*ky(j))
- else
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kx(i))/(0.5*delta*kx(i))* &
- & sin(0.5*delta*ky(j))/(0.5*delta*ky(j))* &
- & sin(0.5*delta*kz(k))/(0.5*delta*kz(k))
- endif
- enddo
- enddo
- enddo
- do k = 1,fns3
- do j = 1,fns2
- do i = 1,fns1
- kk = sqrt(kx(i)**2 + ky(j)**2 + kz(k)**2)
- if (kk.gt.kc) then
- outk(i,j,k) = 0.0
- end if
- enddo
- enddo
- enddo
- call btran_wrap(outk,out1,ns1,ns2,ns3,fns1,fns2,fns3)
- deallocate(ink)
- deallocate(outk)
-end subroutine speccutboxfilter
-
-subroutine speccutboxfiltersc(in1,out1,nd)
- use solver
- use parallel
- use data
- implicit none
- real(WP) :: kk,delta,nd,dx,kc
- real(WP) :: out1(ns1sc,ns2sc,ns3sc)
- real(WP) :: in1(ns1sc,ns2sc,ns3sc)
- complex(WP), dimension(:,:,:), pointer :: ink
- complex(WP), dimension(:,:,:), pointer :: outk
- integer i,j,k
- dx = L/(real(nx))
- ALLOCATE(ink(fns1sc,fns2sc,fns3sc))
- ALLOCATE(outk(fns1sc,fns2sc,fns3sc))
- call ftran_wrap(in1,ink,ns1sc,ns2sc,ns3sc,fns1sc,fns2sc,fns3sc)
- ink=ink/(real(ns1sc)**3.)
- delta = nd*dx
- kc = 3.141592654/delta
- do k = 1,fns3sc
- do j = 1,fns2sc
- do i = 1,fns1sc
- if(kxsc(i).eq.0.and.kysc(j).eq.0.and.kzsc(k).eq.0) then
- outk(i,j,k) = ink(i,j,k)
- elseif(kxsc(i).eq.0.and.kysc(j).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kzsc(k))/(0.5*delta*kzsc(k))
- elseif(kxsc(i).eq.0.and.kzsc(k).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kysc(j))/(0.5*delta*kysc(j))
- elseif(kysc(j).eq.0.and.kzsc(k).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kxsc(i))/(0.5*delta*kxsc(i))
- elseif(kxsc(i).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kysc(j))/(0.5*delta*kysc(j))* &
- & sin(0.5*delta*kzsc(k))/(0.5*delta*kzsc(k))
- elseif(kysc(j).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kxsc(i))/(0.5*delta*kxsc(i))* &
- & sin(0.5*delta*kzsc(k))/(0.5*delta*kzsc(k))
- elseif(kzsc(k).eq.0) then
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kxsc(i))/(0.5*delta*kxsc(i))* &
- & sin(0.5*delta*kysc(j))/(0.5*delta*kysc(j))
- else
- outk(i,j,k) = ink(i,j,k)*sin(0.5*delta*kxsc(i))/(0.5*delta*kxsc(i))* &
- & sin(0.5*delta*kysc(j))/(0.5*delta*kysc(j))* &
- & sin(0.5*delta*kzsc(k))/(0.5*delta*kzsc(k))
- endif
- enddo
- enddo
- enddo
- do k = 1,fns3sc
- do j = 1,fns2sc
- do i = 1,fns1sc
- kk = sqrt(kxsc(i)**2 + kysc(j)**2 + kzsc(k)**2)
- if (kk.gt.kc) then
- outk(i,j,k) = 0.0
- end if
- enddo
- enddo
- enddo
- call btran_wrap(outk,out1,ns1sc,ns2sc,ns3sc,fns1sc,fns2sc,fns3sc)
- deallocate(ink)
- deallocate(outk)
-end subroutine speccutboxfiltersc
-
-
-
-subroutine specgaussfiltersc(in1,out1,nd)
- use solver
- use parallel
- use data
- implicit none
- real(WP) :: kk,delta,nd,dx
- real(WP) :: out1(ns1sc,ns2sc,ns3sc)
- real(WP) :: in1(ns1sc,ns2sc,ns3sc)
- complex(WP), dimension(:,:,:), pointer :: ink
- complex(WP), dimension(:,:,:), pointer :: outk
- integer i,j,k
- dx = L/(real(nxsc))
- ALLOCATE(ink(fns1sc,fns2sc,fns3sc))
- ALLOCATE(outk(fns1sc,fns2sc,fns3sc))
- call ftran_wrap(in1,ink,ns1sc,ns2sc,ns3sc,fns1sc,fns2sc,fns3sc)
- ink=ink/(real(ns1sc)**3.)
- delta = nd*dx
- do k = 1,fns3sc
- do j = 1,fns2sc
- do i = 1,fns1sc
- kk = (kxsc(i)**2 + kysc(j)**2 + kzsc(k)**2)**(0.5)
- outk(i,j,k) = ink(i,j,k)*exp(-(kk*delta)**2/24.)
- enddo
- enddo
- enddo
- call btran_wrap(outk,out1,ns1sc,ns2sc,ns3sc,fns1sc,fns2sc,fns3sc)
- deallocate(ink)
- deallocate(outk)
-end subroutine specgaussfiltersc
-
-subroutine specgaussfilter(in1,out1,nd)
- use solver
- use parallel
- use data
- implicit none
- real(WP) :: kk,delta,nd,dx
- real(WP) :: out1(ns1,ns2,ns3)
- real(WP) :: in1(ns1,ns2,ns3)
- complex(WP), dimension(:,:,:), pointer :: ink
- complex(WP), dimension(:,:,:), pointer :: outk
- integer i,j,k
- dx = L/(real(nx))
- ALLOCATE(ink(fns1,fns2,fns3))
- ALLOCATE(outk(fns1,fns2,fns3))
- call ftran_wrap(in1,ink,ns1,ns2,ns3,fns1,fns2,fns3)
- ink=ink/(real(ns1)**3.)
- delta = nd*dx
- do k = 1,fns3
- do j = 1,fns2
- do i = 1,fns1
- kk = (kx(i)**2 + ky(j)**2 + kz(k)**2)**(0.5)
- outk(i,j,k) = ink(i,j,k)*exp(-(kk*delta)**2/24.)
- enddo
- enddo
- enddo
- call btran_wrap(outk,out1,ns1,ns2,ns3,fns1,fns2,fns3)
- deallocate(ink)
- deallocate(outk)
-end subroutine specgaussfilter
-
-subroutine curl(inx,iny,inz,curlx,curly,curlz)
- use solver
- use parallel
- use data
- implicit none
- integer :: i,j,k
- real(WP) :: inx(ns1,ns2,ns3),iny(ns1,ns2,ns3),inz(ns1,ns2,ns3)
- real(WP) :: curlx(ns1,ns2,ns3)
- real(WP) :: curly(ns1,ns2,ns3)
- real(WP) :: curlz(ns1,ns2,ns3)
- complex(WP), dimension(:,:,:), pointer :: inxk,inyk,inzk,curlxk,curlyk,curlzk
- ALLOCATE(inxk(fns1,fns2,fns3))
- ALLOCATE(inyk(fns1,fns2,fns3))
- ALLOCATE(inzk(fns1,fns2,fns3))
- ALLOCATE(curlxk(fns1,fns2,fns3))
- ALLOCATE(curlyk(fns1,fns2,fns3))
- ALLOCATE(curlzk(fns1,fns2,fns3))
- call ftran_wrap(inx,inxk,ns1,ns2,ns3,fns1,fns2,fns3)
- call ftran_wrap(iny,inyk,ns1,ns2,ns3,fns1,fns2,fns3)
- call ftran_wrap(inz,inzk,ns1,ns2,ns3,fns1,fns2,fns3)
- inxk=inxk/(real(ns1)**3.)
- inyk=inyk/(real(ns1)**3.)
- inzk=inzk/(real(ns1)**3.)
- do k = 1,fns3
- do j = 1,fns2
- do i = 1,fns1
- curlxk(i,j,k) = ii*ky(j)*inzk(i,j,k) - ii*kz(k)*inyk(i,j,k)
- curlyk(i,j,k) = ii*kz(k)*inxk(i,j,k) - ii*kx(i)*inzk(i,j,k)
- curlzk(i,j,k) = ii*kx(i)*inyk(i,j,k) - ii*ky(j)*inxk(i,j,k)
- enddo
- enddo
- enddo
- call btran_wrap(curlxk,curlx,ns1,ns2,ns3,fns1,fns2,fns3)
- call btran_wrap(curlyk,curly,ns1,ns2,ns3,fns1,fns2,fns3)
- call btran_wrap(curlzk,curlz,ns1,ns2,ns3,fns1,fns2,fns3)
- deallocate(curlxk)
- deallocate(curlyk)
- deallocate(curlzk)
- deallocate(inxk)
- deallocate(inyk)
- deallocate(inzk)
-end subroutine curl
-
-subroutine gradntsc(in,nd,ddx,ddy,ddz,nt)
- use solver
- use parallel
- use data
- implicit none
- integer :: i,j,k
- integer :: nd, nt
-
- real(WP) :: in(ns1sc,ns2sc,ns3sc)
- real(WP) :: ddx(ns1sc,ns2sc,ns3sc)
- real(WP) :: ddy(ns1sc,ns2sc,ns3sc)
- real(WP) :: ddz(ns1sc,ns2sc,ns3sc)
- complex(WP), dimension(:,:,:), pointer :: ink,ddxk,ddyk,ddzk
- ALLOCATE(ink(fns1sc,fns2sc,fns3sc))
- ALLOCATE(ddxk(fns1sc,fns2sc,fns3sc))
- ALLOCATE(ddyk(fns1sc,fns2sc,fns3sc))
- ALLOCATE(ddzk(fns1sc,fns2sc,fns3sc))
- call ftran_wrap(in,ink,ns1sc,ns2sc,ns3sc,fns1sc,fns2sc,fns3sc)
- ink=ink/(real(ns1sc)**3.)
- do k = 1,fns3sc
- do j = 1,fns2sc
- do i = 1,fns1sc
- ddxk(i,j,k)=(ii*kxsc(i))**(real(nt))*ink(i,j,k)
- ddyk(i,j,k)=(ii*kysc(j))**(real(nt))*ink(i,j,k)
- ddzk(i,j,k)=(ii*kzsc(k))**(real(nt))*ink(i,j,k)
- enddo
- enddo
- enddo
- call btran_wrap(ddxk,ddx,ns1sc,ns2sc,ns3sc,fns1sc,fns2sc,fns3sc)
- call btran_wrap(ddyk,ddy,ns1sc,ns2sc,ns3sc,fns1sc,fns2sc,fns3sc)
- call btran_wrap(ddzk,ddz,ns1sc,ns2sc,ns3sc,fns1sc,fns2sc,fns3sc)
- deallocate(ddxk)
- deallocate(ddyk)
- deallocate(ddzk)
- deallocate(ink)
-end subroutine gradntsc
-
-subroutine gradientsc(in,nd,ddx,ddy,ddz)
- use solver
- use parallel
- use data
- implicit none
- integer :: i,j,k
- integer :: nd
-
- real(WP) :: in(ns1sc,ns2sc,ns3sc)
- real(WP) :: ddx(ns1sc,ns2sc,ns3sc)
- real(WP) :: ddy(ns1sc,ns2sc,ns3sc)
- real(WP) :: ddz(ns1sc,ns2sc,ns3sc)
- complex(WP), dimension(:,:,:), pointer :: ink,ddxk,ddyk,ddzk
- ALLOCATE(ink(fns1sc,fns2sc,fns3sc))
- ALLOCATE(ddxk(fns1sc,fns2sc,fns3sc))
- ALLOCATE(ddyk(fns1sc,fns2sc,fns3sc))
- ALLOCATE(ddzk(fns1sc,fns2sc,fns3sc))
- call ftran_wrap(in,ink,ns1sc,ns2sc,ns3sc,fns1sc,fns2sc,fns3sc)
- ink=ink/(real(ns1sc)**3.)
- do k = 1,fns3sc
- do j = 1,fns2sc
- do i = 1,fns1sc
- ddxk(i,j,k)=ii*kxsc(i)*ink(i,j,k)
- ddyk(i,j,k)=ii*kysc(j)*ink(i,j,k)
- ddzk(i,j,k)=ii*kzsc(k)*ink(i,j,k)
- enddo
- enddo
- enddo
- call btran_wrap(ddxk,ddx,ns1sc,ns2sc,ns3sc,fns1sc,fns2sc,fns3sc)
- call btran_wrap(ddyk,ddy,ns1sc,ns2sc,ns3sc,fns1sc,fns2sc,fns3sc)
- call btran_wrap(ddzk,ddz,ns1sc,ns2sc,ns3sc,fns1sc,fns2sc,fns3sc)
- deallocate(ddxk)
- deallocate(ddyk)
- deallocate(ddzk)
- deallocate(ink)
-end subroutine gradientsc
-
-subroutine gradient(in,nd,ddx,ddy,ddz)
- use solver
- use parallel
- use data
- implicit none
- integer :: i,j,k
- integer :: nd
-
- real(WP) :: in(ns1,ns2,ns3)
- real(WP) :: ddx(ns1,ns2,ns3)
- real(WP) :: ddy(ns1,ns2,ns3)
- real(WP) :: ddz(ns1,ns2,ns3)
- complex(WP), dimension(:,:,:), pointer :: ink,ddxk,ddyk,ddzk
- ALLOCATE(ink(fns1,fns2,fns3))
- ALLOCATE(ddxk(fns1,fns2,fns3))
- ALLOCATE(ddyk(fns1,fns2,fns3))
- ALLOCATE(ddzk(fns1,fns2,fns3))
- call ftran_wrap(in,ink,ns1,ns2,ns3,fns1,fns2,fns3)
- ink=ink/(real(ns1)**3.)
- do k = 1,fns3
- do j = 1,fns2
- do i = 1,fns1
- ddxk(i,j,k)=ii*kx(i)*ink(i,j,k)
- ddyk(i,j,k)=ii*ky(j)*ink(i,j,k)
- ddzk(i,j,k)=ii*kz(k)*ink(i,j,k)
- enddo
- enddo
- enddo
- call btran_wrap(ddxk,ddx,ns1,ns2,ns3,fns1,fns2,fns3)
- call btran_wrap(ddyk,ddy,ns1,ns2,ns3,fns1,fns2,fns3)
- call btran_wrap(ddzk,ddz,ns1,ns2,ns3,fns1,fns2,fns3)
- deallocate(ddxk)
- deallocate(ddyk)
- deallocate(ddzk)
- deallocate(ink)
-end subroutine gradient
-
-subroutine cutgradient(in,nd,ddx,ddy,ddz)
- use solver
- use parallel
- use data
- implicit none
- integer :: i,j,k
- real(WP) :: nd, kc, delta, dx, kk
- real(WP) :: in(ns1,ns2,ns3)
- real(WP) :: ddx(ns1,ns2,ns3)
- real(WP) :: ddy(ns1,ns2,ns3)
- real(WP) :: ddz(ns1,ns2,ns3)
- complex(WP), dimension(:,:,:), pointer :: ink,ddxk,ddyk,ddzk
- dx = L/(real(nx))
- delta = nd*dx
- kc = 3.141592654/delta
- ALLOCATE(ink(fns1,fns2,fns3))
- ALLOCATE(ddxk(fns1,fns2,fns3))
- ALLOCATE(ddyk(fns1,fns2,fns3))
- ALLOCATE(ddzk(fns1,fns2,fns3))
- call ftran_wrap(in,ink,ns1,ns2,ns3,fns1,fns2,fns3)
- ink=ink/(real(ns1)**3.)
- do k = 1,fns3
- do j = 1,fns2
- do i = 1,fns1
- ddxk(i,j,k)=ii*kx(i)*ink(i,j,k)
- ddyk(i,j,k)=ii*ky(j)*ink(i,j,k)
- ddzk(i,j,k)=ii*kz(k)*ink(i,j,k)
- kk = sqrt(kx(i)**2 + ky(j)**2 + kz(k)**2)
- if (kk.gt.kc) then
- ddxk(i,j,k) = 0.0
- ddyk(i,j,k) = 0.0
- ddzk(i,j,k) = 0.0
- end if
- enddo
- enddo
- enddo
- call btran_wrap(ddxk,ddx,ns1,ns2,ns3,fns1,fns2,fns3)
- call btran_wrap(ddyk,ddy,ns1,ns2,ns3,fns1,fns2,fns3)
- call btran_wrap(ddzk,ddz,ns1,ns2,ns3,fns1,fns2,fns3)
- deallocate(ddxk)
- deallocate(ddyk)
- deallocate(ddzk)
- deallocate(ink)
-end subroutine cutgradient
-
-subroutine speccutfilter(in1,out1,nd)
- use solver
- use parallel
- use data
- implicit none
- real(WP) :: kk,delta,nd,dx,kc
- real(WP) :: out1(ns1,ns2,ns3)
- real(WP) :: in1(ns1,ns2,ns3)
- complex(WP), dimension(:,:,:), pointer :: ink
- complex(WP), dimension(:,:,:), pointer :: outk
- integer i,j,k
- dx = L/(real(ns1))
- delta = nd*dx
- kc = 3.141592654/delta
- ALLOCATE(ink(fns1,fns2,fns3))
- ALLOCATE(outk(fns1,fns2,fns3))
- call ftran_wrap(in1,ink,ns1,ns2,ns3,fns1,fns2,fns3)
- ink=ink/(real(ns1)**3.)
- outk = ink
- do k = 1,fns3
- do j = 1,fns2
- do i = 1,fns1
- kk = sqrt(kx(i)**2 + ky(j)**2 + kz(k)**2)
- if (kk.gt.kc) then
- outk(i,j,k) = 0.0
- end if
- enddo
- enddo
- enddo
- call btran_wrap(outk,out1,ns1,ns2,ns3,fns1,fns2,fns3)
- deallocate(ink)
- deallocate(outk)
-end subroutine speccutfilter
-
-
-subroutine speccutfiltersc(in1,out1,nd)
- use solver
- use parallel
- use data
- implicit none
- real(WP) :: kk,delta,nd,dx,kc
- real(WP) :: out1(ns1sc,ns2sc,ns3sc)
- real(WP) :: in1(ns1sc,ns2sc,ns3sc)
- complex(WP), dimension(:,:,:), pointer :: ink
- complex(WP), dimension(:,:,:), pointer :: outk
- integer i,j,k
- dx = L/(real(ns1sc))
- delta = nd*dx
- kc = 3.141592654/delta
- ALLOCATE(ink(fns1sc,fns2sc,fns3sc))
- ALLOCATE(outk(fns1sc,fns2sc,fns3sc))
- call ftran_wrap(in1,ink,ns1sc,ns2sc,ns3sc,fns1sc,fns2sc,fns3sc)
- ink=ink/(real(ns1sc)**3.)
- outk = ink
- do k = 1,fns3sc
- do j = 1,fns2sc
- do i = 1,fns1sc
- kk = sqrt(kxsc(i)**2 + kysc(j)**2 + kzsc(k)**2)
- if (kk.gt.kc) then
- outk(i,j,k) = 0.0
- end if
- enddo
- enddo
- enddo
- call btran_wrap(outk,out1,ns1sc,ns2sc,ns3sc,fns1sc,fns2sc,fns3sc)
- deallocate(ink)
- deallocate(outk)
-end subroutine speccutfiltersc
-
-subroutine turbulent_region(t11,t12,t13,t22,t23,t33,ome1,ome2,ome3,out1)
- use solver
- use parallel
- use data
-! use f95_lapack, only: la_syevd
- implicit none
-
- integer :: out1(ns1,ns2,ns3)
- real(WP) :: t11(ns1,ns2,ns3)
- real(WP) :: t12(ns1,ns2,ns3)
- real(WP) :: t13(ns1,ns2,ns3)
- real(WP) :: t22(ns1,ns2,ns3)
- real(WP) :: t23(ns1,ns2,ns3)
- real(WP) :: t33(ns1,ns2,ns3)
- real(WP) :: ome1(ns1,ns2,ns3)
- real(WP) :: ome2(ns1,ns2,ns3)
- real(WP) :: ome3(ns1,ns2,ns3)
- real(WP) :: tab(3,3)
- real(WP) :: vec(3)
- real(WP) :: norm, sca1, sca2, sca3, scamax, lp, lm
-
- integer :: i, j, k
-
- do k = 1, ns3
- do j = 1, ns2
- do i = 1, ns1
- norm = sqrt(ome1(i,j,k)**2.0 + ome2(i,j,k)**2.0 + ome3(i,j,k)**2.0)
- ome1(i,j,k) = ome1(i,j,k) / norm
- ome2(i,j,k) = ome2(i,j,k) / norm
- ome3(i,j,k) = ome3(i,j,k) / norm
- norm = sqrt(ome1(i,j,k)**2.0 + ome2(i,j,k)**2.0 + ome3(i,j,k)**2.0)
- if ( norm.le.0.999.or.norm.ge.1.001) then
- print*,'norm vorticity',sqrt(ome1(i,j,k)**2.0 + ome2(i,j,k)**2.0 + ome3(i,j,k)**2.0),i,j,k
- end if
- end do
- end do
- end do
-
- out1 = 0.
-
- do k = 1, ns3
- do j = 1, ns2
- do i = 1, ns1
-
- tab(1,1) = t11(i,j,k)
- tab(1,2) = t12(i,j,k)
- tab(2,1) = t12(i,j,k)
- tab(1,3) = t13(i,j,k)
- tab(3,1) = t13(i,j,k)
- tab(2,2) = t22(i,j,k)
- tab(2,3) = t23(i,j,k)
- tab(3,2) = t23(i,j,k)
- tab(3,3) = t33(i,j,k)
- vec = 0.
-
-! call la_syevd(tab,vec,'V')
-
- norm = sqrt( tab(1,1)**2.0 + tab(2,1)**2.0 + tab(3,1)**2.0 )
- if (norm.le.0.999.or.norm.ge.1.001) print*,'norm vec1', norm, i,j,k
- norm = sqrt( tab(1,2)**2.0 + tab(2,2)**2.0 + tab(3,2)**2.0 )
- if (norm.le.0.999.or.norm.ge.1.001) print*,'norm vec2', norm, i,j,k
- norm = sqrt( tab(1,3)**2.0 + tab(2,3)**2.0 + tab(3,3)**2.0 )
- if (norm.le.0.999.or.norm.ge.1.001) print*,'norm vec3', norm, i,j,k
-
- !if (rank.eq.0) then
- ! print*,'eigenvector (',tab(1,1),tab(2,1),tab(3,1),') of eigenvector: ',vec(1)
- ! print*,'eigenvector (',tab(1,2),tab(2,2),tab(3,2),') of eigenvector: ',vec(2)
- ! print*,'eigenvector (',tab(1,3),tab(2,3),tab(3,3),') of eigenvector: ',vec(3)
- !end if
- if (vec(2).gt.vec(3).or.vec(2).lt.vec(1)) then
- print*, 'pas le bon ordre pour les valeurs propres', rank,i,j,k
- end if
-
- sca1 = ome1(i,j,k)*tab(1,1) + ome2(i,j,k)*tab(2,1) + ome3(i,j,k)*tab(3,1)
- sca2 = ome1(i,j,k)*tab(1,2) + ome2(i,j,k)*tab(2,2) + ome3(i,j,k)*tab(3,2)
- sca3 = ome1(i,j,k)*tab(1,3) + ome2(i,j,k)*tab(2,3) + ome3(i,j,k)*tab(3,3)
-
- scamax = max(abs(sca1),abs(sca2))
- scamax = max(scamax,abs(sca3))
-
- if (scamax.le.0.5.or.scamax.ge.1.001) print*,'SCAMAX',scamax
-
- if (scamax.eq.sca1) then
- lp = vec(3)
- lm = vec(2)
- else if (scamax.eq.sca2) then
- lp = vec(3)
- lm = vec(1)
- else if (scamax.eq.sca3) then
- lp = vec(2)
- lm = vec(1)
- end if
-
- if (lm.gt.0) out1(i,j,k)=1 ! strain dominated region
- if (lp.ge.0.and.lm.le.0) out1(i,j,k)=2 !strain rate and vorticity comparable
- if (lp.lt.0) out1(i,j,k)=3 ! vorticity dominated region
-
- end do
- end do
- end do
-
-end subroutine turbulent_region
diff --git a/Code_LEGI/precision.f90 b/Code_LEGI/precision.f90
deleted file mode 100755
index aeaef73223f539027fa7cea2039bced95cf78efc..0000000000000000000000000000000000000000
--- a/Code_LEGI/precision.f90
+++ /dev/null
@@ -1,11 +0,0 @@
-module precision
- implicit none
- integer, parameter :: SP = kind(1.0)
- integer, parameter, private :: DP = kind(1.0d0)
- integer, parameter :: WP = DP
- real(WP), private :: sample_real_at_WP
- real(WP), parameter :: MAX_REAL_WP = HUGE(sample_real_at_WP)
- integer, private :: sample_int
- integer, parameter :: MAX_INTEGER = HUGE(sample_int)
-
-end module precision
diff --git a/Code_LEGI/random.f90 b/Code_LEGI/random.f90
deleted file mode 100755
index e1741bebf0b96d740566ad75c9e2da2f14a291ab..0000000000000000000000000000000000000000
--- a/Code_LEGI/random.f90
+++ /dev/null
@@ -1,119 +0,0 @@
-module random
- use precision
- implicit none
-
-contains
-
- ! ------------------------------------------------------------------ !
- ! Normal distribution !
- ! Adapted from the following Fortran 77 code !
- ! ALGORITHM 712, COLLECTED ALGORITHMS FROM ACM. !
- ! THIS WORK PUBLISHED IN TRANSACTIONS ON MATHEMATICAL SOFTWARE, !
- ! VOL. 18, NO. 4, DECEMBER, 1992, PP. 434-435. !
- ! The function random_normal() returns a normally distributed !
- ! pseudo-random number with zero mean and unit variance. !
- ! The algorithm uses the ratio of uniforms method of A.J. Kinderman !
- ! and J.F. Monahan augmented with quadratic bounding curves. !
- ! ------------------------------------------------------------------ !
- real(WP) function random_normal(m,sd)
- implicit none
-
- real(WP), intent(in), optional :: m
- real(WP), intent(in), optional :: sd
- real(WP) :: s = 0.449871_WP
- real(WP) :: t = -0.386595_WP
- real(WP) :: a = 0.19600_WP
- real(WP) :: b = 0.25472_WP
- real(WP) :: r1 = 0.27597_WP
- real(WP) :: r2 = 0.27846_WP
- real(WP) :: u,v,x,y,q
-
- ! Generate P = (u,v) uniform in rectangle enclosing acceptance region
- do
- call random_number(u)
- call random_number(v)
- v=1.7156_WP*(v-0.5_WP)
- ! Evaluate the quadratic form
- x=u-s
- y=abs(v)-t
- q=x**2+y*(a*y-b*x)
- ! Accept P if inside inner ellipse
- if (q<r1) exit
- ! Reject P if outside outer ellipse
- if (q>r2) cycle
- ! Reject P if outside acceptance region
- if (v**2<-4.0_WP*log(u)*u**2) exit
- end do
-
- ! Return ratio of P's coordinates as the normal deviate
- random_normal = v/u
-
- ! Modify to give correct mean and standard deviation
- if (present(sd)) random_normal = random_normal*sd
- if (present(m)) random_normal = random_normal+m
-
- return
- end function random_normal
-
- ! ---------------------------------------------------------------------------- !
- ! Log-normal distribution !
- ! If X has a lognormal distribution, then log(X) is normally distributed. !
- ! Here the logarithm is the natural logarithm, that is to base e, sometimes !
- ! denoted as ln. To generate random variates from this distribution, generate !
- ! a random deviate from the normal distribution with mean and variance equal !
- ! to the mean and variance of the logarithms of X, then take its exponential. !
- ! !
- ! Relationship between the mean & variance of log(X) and the mean & variance !
- ! of X, when X has a lognormal distribution. !
- ! Let m = mean of log(X), and s^2 = variance of log(X) !
- ! Then !
- ! mean of X = exp(m + 0.5s^2) !
- ! variance of X = (mean(X))^2.[exp(s^2) - 1] !
- ! !
- ! In the reverse direction !
- ! variance of log(X) = log[1 + var(X)/(mean(X))^2] !
- ! mean of log(X) = log(mean(X) - 0.5var(log(X)) !
- ! ---------------------------------------------------------------------------- !
- real(WP) function random_lognormal(m,sd)
- implicit none
-
- real(WP), intent(in) :: m
- real(WP), intent(in) :: sd
- real(WP) :: x,mlog,sdlog
-
- sdlog = sqrt(log(1.0_WP+(sd/m)**2))
- mlog = log(m)-0.5_WP*sdlog**2
- x = random_normal(mlog,sdlog)
- random_lognormal = exp(x)
-
- return
- end function random_lognormal
-
-end module random
-
-
-! ------------------------- !
-! Initialization of the RNG !
-! Seeded based on parallel !
-! partitioning !
-! ------------------------- !
-subroutine random_init
- use parallel
- use random
- implicit none
-
- integer :: k
- integer, dimension(:), allocatable :: seed
-
- call RANDOM_SEED(size=k)
- allocate(seed(k))
- call system_clock(count=seed(1))
- seed(1:k) = seed(1:k)*(rank+1)
- call RANDOM_SEED(put=seed)
- deallocate(seed)
-
-
-
- return
-end subroutine random_init
-
diff --git a/Code_LEGI/solver.f90 b/Code_LEGI/solver.f90
deleted file mode 100755
index a13fbb94abcbb92acc824ec1a3ea5cc30a135ff6..0000000000000000000000000000000000000000
--- a/Code_LEGI/solver.f90
+++ /dev/null
@@ -1,993 +0,0 @@
-module solver
-
- use precision
- use advecX
- use advecY
- use advecZ
-
- implicit none
-
- real(WP), dimension(:), allocatable :: kx
- real(WP), dimension(:), allocatable :: ky
- real(WP), dimension(:), allocatable :: kz
-
- real(WP), dimension(:), allocatable :: kxsc
- real(WP), dimension(:), allocatable :: kysc
- real(WP), dimension(:), allocatable :: kzsc
-
- integer :: deal
- real(WP) :: dk,kmax,kcut
- real(WP) :: kmaxsc,kcutsc
-
- real(WP) :: mu_solver, diff_solver
- real(WP) :: courant
-
- integer :: iforce,iscalar,iles,ilessc,ydir,ipost
-
-
- complex(WP), dimension(:,:,:), allocatable :: Uk
- complex(WP), dimension(:,:,:), allocatable :: Vk
- complex(WP), dimension(:,:,:), allocatable :: Wk
- complex(WP), dimension(:,:,:), allocatable :: Zk
- ! Velocity used to advec the scalar
- real(WP), dimension(:,:,:), allocatable :: Usc ! along x
- real(WP), dimension(:,:,:), allocatable :: Vsc ! along y
- real(WP), dimension(:,:,:), allocatable :: Wsc ! along z
-
- complex(WP), dimension(:,:,:),pointer :: Udummy
- complex(WP), dimension(:,:,:),pointer :: Vdummy
- complex(WP), dimension(:,:,:),pointer :: Wdummy
- complex(WP), dimension(:,:,:),pointer :: Zdummy
-
- complex(WP), dimension(:,:,:), allocatable :: nlx
- complex(WP), dimension(:,:,:), allocatable :: nly
- complex(WP), dimension(:,:,:), allocatable :: nlz
- complex(WP), dimension(:,:,:), allocatable :: nlmf
-
- complex(WP), dimension(:,:,:), allocatable :: nlu2x
- complex(WP), dimension(:,:,:), allocatable :: nlu2y
- complex(WP), dimension(:,:,:), allocatable :: nlu2z
-
-
-
- logical, parameter :: flg_inplace = .false.
- complex(WP), parameter :: ii = (0.0_WP,1.0_WP)
- real(WP), parameter :: kmin = 1e-06_WP
-
- real(WP) :: dt,sim_time
-
- integer :: impose
- real(WP) :: cx,cy,cz
-
-end module solver
-
-
-subroutine solver_init
-
- use parallel
- use data
- use solver
- use transform
-
- implicit none
-
- integer :: i,j,k,il,jl,kl,gg(3),simtype
- real(WP) :: pi
- real(WP) :: umax,vmax,wmax
-
-
- allocate(kx(fns1))
- allocate(ky(fns2))
- allocate(kz(fns3))
-
- allocate(kxsc(fns1sc))
- allocate(kysc(fns2sc))
- allocate(kzsc(fns3sc))
-
- pi = acos(-1.0_WP)
- dk = 2.0_WP*pi/L
-
- do i = fnxs,fnxe
- il = i -fnxs+1
- kx(il) = real((i-1),WP)*dk
- enddo
- do i = fnxssc,fnxesc
- il = i -fnxssc+1
- kxsc(il) = real((i-1),WP)*dk
- enddo
-
- do j = fnys,fnye
- jl = j - fnys +1
- ky(jl) = real((j-1),WP)*dk
- if (j.gt.nk) ky(jl) = -real(nx+1-j,WP)*dk
- enddo
- do j = fnyssc,fnyesc
- jl = j - fnyssc +1
- kysc(jl) = real((j-1),WP)*dk
- if (j.gt.nksc) kysc(jl) = -real(nxsc+1-j,WP)*dk
- enddo
-
- do k = fnzs,fnze
- kl = k -fnzs+1
- kz(kl) = real((k-1),WP)*dk
- if (k.gt.nk) kz(kl) = -real(nx+1-k,WP)*dk
- enddo
- do k = fnzssc,fnzesc
- kl = k -fnzssc+1
- kzsc(kl) = real((k-1),WP)*dk
- if (k.gt.nksc) kzsc(kl) = -real(nxsc+1-k,WP)*dk
- enddo
-
-
-! print *,'First checkpoint',rank
-
-
- allocate(Uk(fns1,fns2,fns3))
- allocate(Vk(fns1,fns2,fns3))
- allocate(Wk(fns1,fns2,fns3))
- allocate(Zk(fns1sc,fns2sc,fns3sc))
- allocate(Usc(ns1sc,ns2sc,ns3sc))
- allocate(Vsc(ns1sc,ns2sc,ns3sc))
- allocate(Wsc(ns1sc,ns2sc,ns3sc))
-
- allocate(Udummy(fns1,fns2,fns3))
- allocate(Vdummy(fns1,fns2,fns3))
- allocate(Wdummy(fns1,fns2,fns3))
-!!PAR!! allocate(Zdummy(fns1sc,fns2sc,fns3sc))
-
-
-
- call ftran_wrap(U,Uk,ns1,ns2,ns3,fns1,fns2,fns3)
- call ftran_wrap(V,Vk,ns1,ns2,ns3,fns1,fns2,fns3)
- call ftran_wrap(W,Wk,ns1,ns2,ns3,fns1,fns2,fns3)
- call ftran_wrap(SC,Zk,ns1sc,ns2sc,ns3sc,fns1sc,fns2sc,fns3sc)
-
-
- Uk = Uk/real(nx**3.0,WP)
- Vk = Vk/real(nx**3.0,WP)
- Wk = Wk/real(nx**3.0,WP)
- Zk = Zk/real(nxsc**3.0,WP)
-
- call parallel_max(maxval(abs(Uk)),umax)
- call parallel_max(maxval(abs(Vk)),vmax)
- call parallel_max(maxval(abs(Wk)),wmax)
-
- if (rank.eq.0) then
- print *,' Maximum of U,V,W after trans',umax,vmax,wmax
- endif
-
-
-
-!!$ call data_write_fourier(Uk,Vk,Wk,fns1,fns2,fns3)
-
- allocate(nlx(fns1,fns2,fns3))
- allocate(nly(fns1,fns2,fns3))
- allocate(nlz(fns1,fns2,fns3))
-!!PAR!! allocate(nlmf(fns1sc,fns2sc,fns3sc))
- allocate(nlu2x(fns1,fns2,fns3))
- allocate(nlu2y(fns1,fns2,fns3))
- allocate(nlu2z(fns1,fns2,fns3))
-
-!!$
-!!$ call parallel_max(maxval(abs(Uk)),umax)
-!!$ call parallel_max(maxval(abs(Vk)),vmax)
-!!$ call parallel_max(maxval(abs(Wk)),wmax)
-
-!!$ if (rank.eq.0) then
-!!$ print *,' Maximum U,V,W in solver',umax,vmax,wmax
-!!$ endif
-!!$
-!!$ if (umax.eq.maxval(abs(Uk))) then
-!!$ print *,' Maximum in rank', rank
-!!$ print *,' location ', maxloc(abs(Uk))
-!!$ gg = maxloc(abs(Uk))
-!!$ print *,' max value for conformation', Uk(gg(1),gg(2),gg(3))
-!!$ endif
-!!$
-!!$ if (wmax.eq.maxval(abs(Wk))) then
-!!$ print *,' Maximum in rank W', rank
-!!$ print *,' location W', maxloc(abs(Wk))
-!!$ gg = maxloc(abs(Wk))
-!!$ print *,' max value for W conformation', Wk(gg(1),gg(2),gg(3))
-!!$ endif
-
- sim_time = 0.0_WP
-
- call parser_read('Dealiasing',deal,0)
-
- kmax = sqrt(3.0_WP)*kx(nx/2+1) !sqrt(2.0_WP)*real(nx,WP)/3.0_WP !sqrt(3.0_WP)*real((nx/2+1),WP)
-!!PAR!! kmaxsc = sqrt(3.0_WP)*kxsc(nxsc/2+1) !sqrt(2.0_WP)*real(nx,WP)/3.0_WP !sqrt(3.0_WP)*real((nx/2+1),WP)
- if (deal.eq.1) then
- kcut = 2.0_WP/3.0_WP*kmax
-!!PAR!! kcutsc = 2.0_WP/3.0_WP*kmaxsc
- else
- kcut = 10000.0_WP
-!!PAR!! kcutsc = 10000.0_WP
- endif
-
- mu_solver = mu
- diff_solver = diff
-
- call parser_read('LES model',iles,0)
- call parser_read('LES scalar model',ilessc,0)
- call parser_read('y inhomogeneity',ydir,0)
-
- call parser_read('Postprocessing',ipost,0)
-
- call parser_read('Forcing',iforce,0)
- if (iforce.eq.1) call forcing_init
-
- call parser_read('Courant number', courant,0.5_WP)
-
-!!!! Determine if it is required to solver the scalar equation
-!!!! If running from scratch with forcing, dont solver scalar equation
-
- call parser_read('Simulation type', simtype)
- call parser_read('Compute scalar', iscalar)
- if (iscalar.eq.0) then
- if (rank.eq.0) print *,'Not solving scalar transport equation .....'
- endif
-
- call parser_read('Imposing mean gradient',impose,0)
- if (impose.eq.1) then
- call parser_read('X-gradient',cx,0.0_WP)
- call parser_read('Y-gradient',cy,0.0_WP)
- call parser_read('Z-gradient',cz,0.0_WP)
- else
- cx = 0.0_WP
- cy = 0.0_WP
- cz = 0.0_WP
- endif
-
- spfilename = 'spectrum_solver.init'
- spfilename2 = 'spectrum_solver.init.z'
- call get_dns_numbers(0)
-
- print*,'test U init solver', U(1,1,1), V(1,1,1),W(1,1,1), SC(1,1,1), SC(ns1,ns2,ns3)
-
-end subroutine solver_init
-
-
-
-subroutine solver_step
-
- use solver
- use parallel
- use data
-
- implicit none
-
- complex(WP), dimension(:,:,:), allocatable :: Pressk
- real(WP), dimension(:,:,:), allocatable :: tab
- character(len=str_long) :: sim_name
- real(WP) :: Ufz, Vfz, Wfz
-
- integer :: i,j,k,ierr
-
- real(WP) :: kk,h, divumax
-
-
- allocate(Pressk(fns1,fns2,fns3))
- allocate(tab(ns1,ns2,ns3))
-
-
-!!$ if (rank.eq.0) print *,' Viscosity', mu_solver
-!!!! GEL DU CHAMP DE VITESSE POUR LES TEST !!!!
-call parser_read('Simulation name', sim_name)
-if (trim(sim_name).eq.'Test case') then
- call parser_read('Frozen U', Ufz)
- call parser_read('Frozen V', Vfz)
- call parser_read('Frozen W', Wfz)
- U = Ufz
- V = Vfz
- W = Wfz
- print*,'1. U,V,W',U(1,1,1),V(1,1,1),W(1,1,1) !!!! GEL DU CHAMP DE VITESSE POUR LES TESTS !!!!
-endif
-
- call get_timestep
- sim_time = sim_time +dt
-
-!!!!!!!!!!!!
-!!! Second-order RK scheme
-!!!!!!!!!!!
- h = dt/2.0_WP
-
- do k = 1,fns3
- do j = 1,fns2
- do i = 1,fns1
- Udummy(i,j,k) = Uk(i,j,k)
- Vdummy(i,j,k) = Vk(i,j,k)
- Wdummy(i,j,k) = Wk(i,j,k)
- enddo
- enddo
- enddo
-
- call non_linear
-
-! if (iforce.eq.1) call force_compute
-!!!!!! Step 1 for RK scheme
- do k = 1,fns3
- do j = 1,fns2
- do i = 1,fns1
- kk = kx(i)**2.0 + ky(j)**2.0 + kz(k)**2.0
- Uk(i,j,k) = (Uk(i,j,k) + h*nlx(i,j,k))/exp(mu_solver*kk*h)
- Vk(i,j,k) = (Vk(i,j,k) + h*nly(i,j,k))/exp(mu_solver*kk*h)
- Wk(i,j,k) = (Wk(i,j,k) + h*nlz(i,j,k))/exp(mu_solver*kk*h)
- enddo
- enddo
- enddo
-
-
-!!$
-!!$!!!!!!! Step 2 for RK scheme
-!!$
- call non_linear
- if (iforce.eq.1) call force_compute
-
- do k = 1,fns3
- do j = 1,fns2
- do i = 1,fns1
- kk = kx(i)**2.0 + ky(j)**2.0 + kz(k)**2.0
- Uk(i,j,k) = (Udummy(i,j,k) + dt*nlx(i,j,k)*exp(mu_solver*kk*h))/exp(mu_solver*kk*dt)
- Vk(i,j,k) = (Vdummy(i,j,k) + dt*nly(i,j,k)*exp(mu_solver*kk*h))/exp(mu_solver*kk*dt)
- Wk(i,j,k) = (Wdummy(i,j,k) + dt*nlz(i,j,k)*exp(mu_solver*kk*h))/exp(mu_solver*kk*dt)
- enddo
- enddo
- enddo
-
- ! Projection
- do k = 1,fns3
- do j = 1,fns2
- do i = 1,fns1
- kk = kx(i)**2.0 + ky(j)**2.0 + kz(k)**2.0
- if(kk.gt.0.0_WP) then
- Pressk(i,j,k) = - ( ii*kx(i)*Uk(i,j,k) + ii*ky(j)*Vk(i,j,k) + ii*kz(k)*Wk(i,j,k) )/kk
- end if
- Uk(i,j,k) = Uk(i,j,k) - ii*kx(i)*Pressk(i,j,k)
- Vk(i,j,k) = Vk(i,j,k) - ii*ky(j)*Pressk(i,j,k)
- Wk(i,j,k) = Wk(i,j,k) - ii*kz(k)*Pressk(i,j,k)
- Pressk(i,j,k) = - ( ii*kx(i)*Uk(i,j,k) + ii*ky(j)*Vk(i,j,k) + ii*kz(k)*Wk(i,j,k) )
- end do
- end do
- end do
-! call btran_wrap(Pressk,tab,ns1,ns2,ns3,fns1,fns2,fns3)
-! call parallel_max(maxval(abs(tab)),divumax)
-! if (rank.eq.0) print*,'divergence max = ', divumax
-! call parallel_max(maxval(abs(Uk)),divumax)
-! if (rank.eq.0) print*,'abs(Uk) max = ', divumax
-
-!!PAR!! - INTERFACAGE AVEC LA METHODE PARTICULAIRE
-
- call ftran_wrap(SC,Zk,ns1sc,ns2sc,ns3sc,fns1sc,fns2sc,fns3sc)
- Zk = Zk/real(nxsc**3.0,WP)
- if (iscalar.ne.0) then
- do k = 1,fns3sc
- do j = 1,fns2sc
- do i = 1,fns1sc
- kk = kxsc(i)**2.0 + kysc(j)**2.0 + kzsc(k)**2.0
- Zk(i,j,k) = Zk(i,j,k)/exp(diff_solver*kk*dt)
- enddo
- enddo
- enddo
- end if
- call btran_wrap(Zk,SC,ns1sc,ns2sc,ns3sc,fns1sc,fns2sc,fns3sc)
- if (nproc.ne.1) then
- if (rank.eq.0) print*,'NOT AVAILABLE IN PARALLEL'
- STOP
- else
-
-!!PAR!! 1. on remet les vitesses dans l'espace physique
- if (trim(sim_name).eq.'Test case') then
- call parser_read('Frozen U', Ufz)
- call parser_read('Frozen V', Vfz)
- call parser_read('Frozen W', Wfz)
- U = Ufz
- V = Vfz
- W = Wfz
- print*,'1b. U,V,W',U(1,1,1),V(1,1,1),W(1,1,1) !!!! GEL DU CHAMP DE VITESSE POUR LES TESTS !!!!
- endif
- if (trim(sim_name).ne.'Test case') call u_compute !!!! GEL DU CHAMP DE VITESSE POUR LES TESTS !!!!
- if (trim(sim_name).eq.'Test case') print*,'2. U,V,W',U(1,1,1),V(1,1,1),W(1,1,1) !!!! GEL DU CHAMP DE VITESSE POUR LES TESTS !!!!
-
-
- Usc = 0.0
- Vsc = 0.0
- Wsc = 0.0
-
- if (ns1sc.gt.ns1) then
- call discretisation2(U,Usc,ns1,ns2,ns3,ns1sc,ns2sc,ns3sc)
- call discretisation2(V,Vsc,ns1,ns2,ns3,ns1sc,ns2sc,ns3sc)
- call discretisation2(W,Wsc,ns1,ns2,ns3,ns1sc,ns2sc,ns3sc)
- else if (ns1sc.lt.ns1) then
- call discretisation3(U,Usc,ns1,ns2,ns3,ns1sc,ns2sc,ns3sc)
- call discretisation3(V,Vsc,ns1,ns2,ns3,ns1sc,ns2sc,ns3sc)
- call discretisation3(W,wsc,ns1,ns2,ns3,ns1sc,ns2sc,ns3sc)
- else
- Usc = U
- Vsc = V
- Wsc = W
- end if
-
-!!PAR!! 2. appelle du transport particulaire
- call advecX_calc(dt, Usc, SC)
- call advecY_calc(dt, Vsc, SC)
- call advecZ_calc(dt, Wsc, SC)
-
- end if
-!!PAR!! - FIN - INTERFACAGE AVEC LA METHODE PARTICULAIRE
-
-
-
- deallocate(Pressk)
- deallocate(tab)
-
-
-end subroutine solver_step
-
-subroutine non_linear
-
- use solver
- use parallel
- use data
-
- implicit none
-
- real(WP), dimension(:,:,:),allocatable :: ddx,ddy,ddz,nis
- real(WP), dimension(:,:,:),allocatable :: us,vs,ws
- real(WP), dimension(:,:,:),allocatable :: uss,vss,wss
- complex(WP), dimension(:,:,:),allocatable :: ddxk,ddyk,ddzk
- ! LES
-
- complex(WP) :: knl
- real(WP) :: kk
-
- integer :: i,j,k
- real(WP) :: umax,vmax,wmax
-
- integer :: sizemess, tag, ierr, status(MPI_STATUS_SIZE)
- integer :: yeloc, ysloc, yelocsc, yslocsc, rank2send1, rank2send2, fs1, fe1, fs2, fe2, fnysrank, fnyerank, cptrank
-
-
-
- allocate(ddx(ns1,ns2,ns3))
- allocate(ddy(ns1,ns2,ns3))
- allocate(ddz(ns1,ns2,ns3))
- allocate(nis(ns1,ns2,ns3))
-
- allocate(ddxk(fns1,fns2,fns3))
- allocate(ddyk(fns1,fns2,fns3))
- allocate(ddzk(fns1,fns2,fns3))
-
-
- allocate(us(ns1,ns2,ns3))
- allocate(vs(ns1,ns2,ns3))
- allocate(ws(ns1,ns2,ns3))
-
-!!!!!!!!!!!
-!! Convert velocity to spatial coordinates
-!!!!!!!!!!
-
- call btran_wrap(Uk,us,ns1,ns2,ns3,fns1,fns2,fns3)
- call btran_wrap(Vk,vs,ns1,ns2,ns3,fns1,fns2,fns3)
- call btran_wrap(Wk,ws,ns1,ns2,ns3,fns1,fns2,fns3)
-
-!!$ call parallel_max(maxval(abs(us)),umax)
-!!$ call parallel_max(maxval(abs(vs)),vmax)
-!!$ call parallel_max(maxval(abs(ws)),wmax)
-!!$
-!!$! if (rank.eq.0) write(*,'(A10,3(E12.5,3X))') ' MAX VAL', umax,vmax,wmax
-
-
-!!$ if (rank.eq.0) print *,' After velocity conversion'
-
-
-!!!!!!!!!!
-!! Form the first term in the skew-symmetric form
-!!!!!!!!!
-
-
-!!!! U component
-
- do k = 1,ns3
- do j = 1,ns2
- do i = 1,ns1
- ddx(i,j,k) = us(i,j,k)*us(i,j,k)
- ddy(i,j,k) = vs(i,j,k)*us(i,j,k)
- ddz(i,j,k) = ws(i,j,k)*us(i,j,k)
- enddo
- enddo
- enddo
-
- call ftran_wrap(ddx,ddxk,ns1,ns2,ns3,fns1,fns2,fns3)
- call ftran_wrap(ddy,ddyk,ns1,ns2,ns3,fns1,fns2,fns3)
- call ftran_wrap(ddz,ddzk,ns1,ns2,ns3,fns1,fns2,fns3)
-
- ddxk = ddxk/real(ns1**3.0,WP)
- ddyk = ddyk/real(ns1**3.0,WP)
- ddzk = ddzk/real(ns1**3.0,WP)
-
- do k = 1,fns3
- do j = 1,fns2
- do i = 1,fns1
- nlu2x(i,j,k) = ii*(kx(i)*ddxk(i,j,k) + &
- &ky(j)*ddyk(i,j,k) + kz(k)*ddzk(i,j,k))
- enddo
- enddo
- enddo
-
-!!!! V component
-
- do k = 1,ns3
- do j = 1,ns2
- do i = 1,ns1
- ddx(i,j,k) = us(i,j,k)*vs(i,j,k)
- ddy(i,j,k) = vs(i,j,k)*vs(i,j,k)
- ddz(i,j,k) = ws(i,j,k)*vs(i,j,k)
- enddo
- enddo
- enddo
-
- call ftran_wrap(ddx,ddxk,ns1,ns2,ns3,fns1,fns2,fns3)
- call ftran_wrap(ddy,ddyk,ns1,ns2,ns3,fns1,fns2,fns3)
- call ftran_wrap(ddz,ddzk,ns1,ns2,ns3,fns1,fns2,fns3)
-
- ddxk = ddxk/real(ns1**3.0,WP)
- ddyk = ddyk/real(ns1**3.0,WP)
- ddzk = ddzk/real(ns1**3.0,WP)
-
-
- do k = 1,fns3
- do j = 1,fns2
- do i = 1,fns1
- nlu2y(i,j,k) = ii*(kx(i)*ddxk(i,j,k) + &
- &ky(j)*ddyk(i,j,k) + kz(k)*ddzk(i,j,k))
- enddo
- enddo
- enddo
-
-!!!! W component
-
- do k = 1,ns3
- do j = 1,ns2
- do i = 1,ns1
- ddx(i,j,k) = us(i,j,k)*ws(i,j,k)
- ddy(i,j,k) = vs(i,j,k)*ws(i,j,k)
- ddz(i,j,k) = ws(i,j,k)*ws(i,j,k)
- enddo
- enddo
- enddo
-
- call ftran_wrap(ddx,ddxk,ns1,ns2,ns3,fns1,fns2,fns3)
- call ftran_wrap(ddy,ddyk,ns1,ns2,ns3,fns1,fns2,fns3)
- call ftran_wrap(ddz,ddzk,ns1,ns2,ns3,fns1,fns2,fns3)
-
- ddxk = ddxk/real(ns1**3.0,WP)
- ddyk = ddyk/real(ns1**3.0,WP)
- ddzk = ddzk/real(ns1**3.0,WP)
-
-
- do k = 1,fns3
- do j = 1,fns2
- do i = 1,fns1
- nlu2z(i,j,k) = ii*(kx(i)*ddxk(i,j,k) + &
- &ky(j)*ddyk(i,j,k) + kz(k)*ddzk(i,j,k))
- enddo
- enddo
- enddo
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!! Compute the second term in the skew symmetric form
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-!!!!!!!!!!!!!!
-!! Compute U products
-!!!!!!!!!!!!!!
- do k = 1,fns3
- do j = 1,fns2
- do i = 1,fns1
- ddxk(i,j,k) = ii*kx(i)*Uk(i,j,k)
- ddyk(i,j,k) = ii*ky(j)*Uk(i,j,k)
- ddzk(i,j,k) = ii*kz(k)*Uk(i,j,k)
- enddo
- enddo
- enddo
-
- ddx = 0.0_WP
- ddy = 0.0_WP
- ddz = 0.0_WP
-
-
- call btran_wrap(ddxk,ddx,ns1,ns2,ns3,fns1,fns2,fns3)
- call btran_wrap(ddyk,ddy,ns1,ns2,ns3,fns1,fns2,fns3)
- call btran_wrap(ddzk,ddz,ns1,ns2,ns3,fns1,fns2,fns3)
-
-!!$ if (rank.eq.0) print *,' After btran in U computations'
-
- do k = 1,ns3
- do j = 1,ns2
- do i = 1,ns1
- nis(i,j,k) = us(i,j,k)*ddx(i,j,k) + &
- & vs(i,j,k)*ddy(i,j,k) +&
- & ws(i,j,k)*ddz(i,j,k)
- enddo
- enddo
- enddo
-
-!!$ if (rank.eq.0) print *,' After product evaluations'
-
- call ftran_wrap(nis,nlx,ns1,ns2,ns3,fns1,fns2,fns3)
-
-!!$ if (rank.eq.0) print *,' After forward transforms'
-
- nlx = nlx/real((ns1**3.0),WP)
-
-!!$ if (rank.eq.0) print *,' After nlx computation'
-
-!!!!!!!!!!!!!!
-!! Compute U products
-!!!!!!!!!!!!!!
- do k = 1,fns3
- do j = 1,fns2
- do i = 1,fns1
- ddxk(i,j,k) = ii*kx(i)*Vk(i,j,k)
- ddyk(i,j,k) = ii*ky(j)*Vk(i,j,k)
- ddzk(i,j,k) = ii*kz(k)*Vk(i,j,k)
- enddo
- enddo
- enddo
-
- ddx = 0.0_WP
- ddy = 0.0_WP
- ddz = 0.0_WP
-
-
- call btran_wrap(ddxk,ddx,ns1,ns2,ns3,fns1,fns2,fns3)
- call btran_wrap(ddyk,ddy,ns1,ns2,ns3,fns1,fns2,fns3)
- call btran_wrap(ddzk,ddz,ns1,ns2,ns3,fns1,fns2,fns3)
-
-!!$ if (rank.eq.0) print *,' After b trans in V compute'
-
- do k = 1,ns3
- do j = 1,ns2
- do i = 1,ns1
- nis(i,j,k) = us(i,j,k)*ddx(i,j,k) + &
- & vs(i,j,k)*ddy(i,j,k) +&
- & ws(i,j,k)*ddz(i,j,k)
- enddo
- enddo
- enddo
-
-!!$ if (rank.eq.0) print *,' After product eval. in V'
-
- call ftran_wrap(nis,nly,ns1,ns2,ns3,fns1,fns2,fns3)
-
-!!$ if (rank.eq.0) print *,' After forward trans in V'
-
- nly = nly/real((ns1**3.0),WP)
-
-!!$ if (rank.eq.0) print *,' After nly computation'
-
-!!!!!!!!!!!!!!
-!! Compute W products
-!!!!!!!!!!!!!!
- do k = 1,fns3
- do j = 1,fns2
- do i = 1,fns1
- ddxk(i,j,k) = ii*kx(i)*Wk(i,j,k)
- ddyk(i,j,k) = ii*ky(j)*Wk(i,j,k)
- ddzk(i,j,k) = ii*kz(k)*Wk(i,j,k)
- enddo
- enddo
- enddo
-
- ddx = 0.0_WP
- ddy = 0.0_WP
- ddz = 0.0_WP
-
- call btran_wrap(ddxk,ddx,ns1,ns2,ns3,fns1,fns2,fns3)
- call btran_wrap(ddyk,ddy,ns1,ns2,ns3,fns1,fns2,fns3)
- call btran_wrap(ddzk,ddz,ns1,ns2,ns3,fns1,fns2,fns3)
-
- do k = 1,ns3
- do j = 1,ns2
- do i = 1,ns1
- nis(i,j,k) = us(i,j,k)*ddx(i,j,k) + &
- & vs(i,j,k)*ddy(i,j,k) +&
- & ws(i,j,k)*ddz(i,j,k)
- enddo
- enddo
- enddo
-
- call ftran_wrap(nis,nlz,ns1,ns2,ns3,fns1,fns2,fns3)
-
- nlz = nlz/real((ns1**3.0),WP)
-
-!!$ if (rank.eq.0) print *,' After nlz computation'
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!! Form the complex skew-symmetric form
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!$
- do k = 1,fns3
- do j = 1,fns2
- do i = 1,fns1
- nlx(i,j,k) = 0.5*(nlx(i,j,k) + nlu2x(i,j,k))
- nly(i,j,k) = 0.5*(nly(i,j,k) + nlu2y(i,j,k))
- nlz(i,j,k) = 0.5*(nlz(i,j,k) + nlu2z(i,j,k))
- enddo
- enddo
- enddo
-
-
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!! Form non-linear term for the scalar
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- deallocate(ddx)
- deallocate(ddy)
- deallocate(ddz)
- deallocate(ddxk)
- deallocate(ddyk)
- deallocate(ddzk)
- deallocate(nis)
-
-
-!!PAR!! if (iscalar.eq.0) then
-
- deallocate(us)
- deallocate(vs)
- deallocate(ws)
-!!PAR!! nlmf = 0.0_WP
-
-!!PAR!! else
-
-!!PAR!! allocate(ddx(ns1sc,ns2sc,ns3sc))
-!!PAR!! allocate(ddy(ns1sc,ns2sc,ns3sc))
-!!PAR!! allocate(ddz(ns1sc,ns2sc,ns3sc))
-!!PAR!! allocate(nis(ns1sc,ns2sc,ns3sc))
-
-!!PAR!! allocate(ddxk(fns1sc,fns2sc,fns3sc))
-!!PAR!! allocate(ddyk(fns1sc,fns2sc,fns3sc))
-!!PAR!! allocate(ddzk(fns1sc,fns2sc,fns3sc))
-
-!!PAR!! do k = 1,fns3sc
-!!PAR!! do j = 1,fns2sc
-!!PAR!! do i = 1,fns1sc
-!!PAR!! ddxk(i,j,k) = ii*kxsc(i)*Zk(i,j,k)
-!!PAR!! ddyk(i,j,k) = ii*kysc(j)*Zk(i,j,k)
-!!PAR!! ddzk(i,j,k) = ii*kzsc(k)*Zk(i,j,k)
-!!PAR!! enddo
-!!PAR!! enddo
-!!PAR!! enddo
-
-!!PAR!! ddx = 0.0_WP
-!!PAR!! ddy = 0.0_WP
-!!PAR!! ddz = 0.0_WP
-
-!!PAR!! call btran_wrap(ddxk,ddx,ns1sc,ns2sc,ns3sc,fns1sc,fns2sc,fns3sc)
-!!PAR!! call btran_wrap(ddyk,ddy,ns1sc,ns2sc,ns3sc,fns1sc,fns2sc,fns3sc)
-!!PAR!! call btran_wrap(ddzk,ddz,ns1sc,ns2sc,ns3sc,fns1sc,fns2sc,fns3sc)
-
-!!PAR!! deallocate(ddxk)
-!!PAR!! deallocate(ddyk)
-!!PAR!! deallocate(ddzk)
-
-!!PAR!! allocate(uss(ns1sc,ns2sc,ns3sc))
-!!PAR!! allocate(vss(ns1sc,ns2sc,ns3sc))
-!!PAR!! allocate(wss(ns1sc,ns2sc,ns3sc))
-!!PAR!! uss = 0.0
-!!PAR!! vss = 0.0
-!!PAR!! wss = 0.0
-
-!!PAR!! if (ns1sc.gt.ns1) then
-!!PAR!! call discretisation2(us,uss,ns1,ns2,ns3,ns1sc,ns2sc,ns3sc)
-!!PAR!! call discretisation2(vs,vss,ns1,ns2,ns3,ns1sc,ns2sc,ns3sc)
-!!PAR!! call discretisation2(ws,wss,ns1,ns2,ns3,ns1sc,ns2sc,ns3sc)
-!!PAR!! else if (ns1sc.lt.ns1) then
-!!PAR!! call discretisation3(us,uss,ns1,ns2,ns3,ns1sc,ns2sc,ns3sc)
-!!PAR!! call discretisation3(vs,vss,ns1,ns2,ns3,ns1sc,ns2sc,ns3sc)
-!!PAR!! call discretisation3(ws,wss,ns1,ns2,ns3,ns1sc,ns2sc,ns3sc)
-!!PAR!! else
-!!PAR!! uss = us
-!!PAR!! vss = vs
-!!PAR!! wss = ws
-!!PAR!! end if
-
-!!PAR!! deallocate(us)
-!!PAR!! deallocate(vs)
-!!PAR!! deallocate(ws)
-
-!!PAR!! do k = 1,ns3sc
-!!PAR!! do j = 1,ns2sc
-!!PAR!! do i = 1,ns1sc
-!!PAR!! nis(i,j,k) = uss(i,j,k)*(ddx(i,j,k)+cx) + &
-!!PAR!! & vss(i,j,k)*(ddy(i,j,k)+cy) +&
-!!PAR!! & wss(i,j,k)*(ddz(i,j,k)+cz)
-!!PAR!! enddo
-!!PAR!! enddo
-!!PAR!! enddo
-!!PAR!! deallocate(uss)
-!!PAR!! deallocate(vss)
-!!PAR!! deallocate(wss)
-!!PAR!! deallocate(ddx)
-!!PAR!! deallocate(ddy)
-!!PAR!! deallocate(ddz)
-
-!!PAR!! call ftran_wrap(nis,nlmf,ns1sc,ns2sc,ns3sc,fns1sc,fns2sc,fns3sc)
-!!PAR!! nlmf = nlmf/real((ns1sc**3.0),WP)
-
-!!PAR!! deallocate(nis)
-
-
-!!PAR!! endif
-
-
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!! Dealias the non-linear term
-
- call dealias
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!! LES MODEL
-
-if (iles.ne.0) then
-! if (iles.eq.1) call smagmodel
- if (iles.eq.2) call dynsmagmodel
-! if (iles.eq.8) call SISM
-! if (iles.eq.12) call dynsmagmodel2
-! if (iles.eq.13) call dynsmagmodel3
-endif
-if (ilessc.ne.0) then
-! if (ilessc.eq.1) call smagmodelsca
-! if (ilessc.eq.2) call dynsmagmodelsca
-! if (ilessc.eq.3) call dynsmagmodelscanew
-! if (ilessc.eq.4) call dynsmagmodelscacut
-! if (ilessc.eq.5) call dynsmagmodelscanewcut
-! if (ilessc.eq.6) call dynsfmodelscacut
-! if (ilessc.eq.7) call dynsfmodelscanewcut
-! if (ilessc.eq.8) call dynsigmamodelscacut
-! if (ilessc.eq.9) call dynsigmamodelscanewcut
-! if (ilessc.eq.12) call dyndd2modelscacut
-! if (ilessc.eq.13) call dyndd4modelscacut
-! if (ilessc.eq.14) call dynddsmagmodelscanewcut
-! if (ilessc.eq.15) call dynsflpmodelscacut
-! if (ilessc.eq.16) call ssmodelscacut
-! if (ilessc.eq.17) call dynsmagtestmodelscacut
-endif
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
-!!!!!!!!!!
-!! Form the pressure term and add it to the nonlinear term
-!!!!!!!!!!
-
-!! SEMBLE NE PAS DONNER DIV(U)=0. ???
-!!
-!! do k = 1,fns3
-!! do j = 1,fns2
-!! do i = 1,fns1
-!!
-!! kk = kx(i)**2.0 + ky(j)**2.0 + kz(k)**2.0
-!! if (sqrt(kk).gt.kmin) then
-!! knl = kx(i)*nlx(i,j,k) + ky(j)*nly(i,j,k) +&
-!! & kz(k)*nlz(i,j,k)
-!! nlx(i,j,k) = kx(i)*knl/kk - nlx(i,j,k)
-!! nly(i,j,k) = ky(j)*knl/kk - nly(i,j,k)
-!! nlz(i,j,k) = kz(k)*knl/kk - nlz(i,j,k)
-!! nlmf(i,j,k) = -nlmf(i,j,k)
-!! else
-!! nlx(i,j,k) = 0.0_WP
-!! nly(i,j,k) = 0.0_WP
-!! nlz(i,j,k) = 0.0_WP
-!! nlmf(i,j,k) = 0.0_WP
-!!!!!!!!!!!!!!!INSTEAD
- nlx = -nlx
- nly = -nly
- nlz = -nlz
-!!PAR!! nlmf = -nlmf
-!! endif
-!! enddo
-!! enddo
-!! enddo
-
-
-end subroutine non_linear
-
-
-subroutine get_timestep
-
- use solver
- use parallel
- use data
-
- real(WP) :: max_s, max_sg
- character(len=str_long) :: sim_name
-
- integer :: ierr,nn
-
- max_s = 0.0_WP
- max_sg = 0.0_WP
-
- call parser_read('Simulation name', sim_name)
- if (trim(sim_name).ne.'Test case') call u_compute !!!! GEL DU CHAMP DE VITESSE POUR LES TESTS !!!!
-
- max_s = maxval(abs(U) +abs(V)+abs(W))
-
-
- call MPI_ALLREDUCE(max_s,max_sg,1,MPI_REAL_WP,MPI_MAX,&
- &MPI_COMM_WORLD,ierr)
-
- call parser_read('fixed time step',dt)
-
- if (dt.eq.0) then
- if (max_sg.gt.0.0_WP) then
- nn = nx
-!!PAR!! if(iscalar.ne.0) nn = max(nx,nxsc)
- dt = courant/max_sg*(L/nn)
- else
- print *,' SOMETHING WRONG IN TIME_STEP', rank, max_sg,max_s,nx
- stop
- endif
- endif
-
-
-!!$ print *,' MAX_TIME ', dt
-
-end subroutine get_timestep
-
-
-subroutine dealias
-
- use solver
- use parallel
- use precision
-
- implicit none
-
- real(WP) :: kk
- integer :: i,j,k
-
- do k = 1,fns3
- do j = 1,fns2
- do i = 1,fns1
-
- kk = sqrt(kx(i)**2.0_WP + ky(j)**2.0_WP + kz(k)**2.0_WP)
- ! kk = sqrt(kk)
-! if ((abs(kz(k)).gt.kmax).or.(abs(ky(j)).gt.kmax).or.(abs(kx(i)).gt.kmax)) then
-! if (kk.gt.kmax) then
- if (kk.gt.kcut) then
- nlx(i,j,k) = 0.0_WP
- nly(i,j,k) = 0.0_WP
- nlz(i,j,k) = 0.0_WP
- endif
- enddo
- enddo
- enddo
-!!PAR!! do k = 1,fns3sc
-!!PAR!! do j = 1,fns2sc
-!!PAR!! do i = 1,fns1sc
-!!PAR!! kk = sqrt(kxsc(i)**2.0_WP + kysc(j)**2.0_WP + kzsc(k)**2.0_WP)
-!!PAR!! if (kk.gt.kcutsc) then
-!!PAR!! nlmf(i,j,k) = 0.0_WP
-!!PAR!! endif
-!!PAR!! enddo
-!!PAR!! enddo
-!!PAR!! enddo
-
-end subroutine dealias
-
-subroutine fourier_write
- use solver
-
-! call data_write_fourier(Uk,Vk,Wk,fns1,fns2,fns3)
-
-end subroutine fourier_write
-
-
diff --git a/Code_LEGI/string.f90 b/Code_LEGI/string.f90
deleted file mode 100755
index 1964ca2b93c943ce19de0271cd677a05be3c191a..0000000000000000000000000000000000000000
--- a/Code_LEGI/string.f90
+++ /dev/null
@@ -1,7 +0,0 @@
-module string
- implicit none
- integer, parameter :: str_short = 8
- integer, parameter :: str_medium = 64
- integer, parameter :: str_long = 4096
-end module string
-
diff --git a/Code_LEGI/tg_init.f90 b/Code_LEGI/tg_init.f90
deleted file mode 100755
index 462520e79752b0e5230c16c32eeb34f1f1350686..0000000000000000000000000000000000000000
--- a/Code_LEGI/tg_init.f90
+++ /dev/null
@@ -1,48 +0,0 @@
-subroutine tg_init
-
- use parallel
- use data
-
-
- implicit none
-
- integer :: i,j,k,tgdim
- real(WP) :: dx,per,acos,yj,zk,xi,factor
-
-
- call parser_read('Length of domain',L)
- call parser_read('Number of points', nx)
- call parser_read('TG dimensions',tgdim,1)
-
-
- dx = L/real(nx-1,WP)
- per = 0.5*L/acos(-1.0)
-
- if (tgdim.eq.1) then
- do k = 1,ns3
- do j = 1,ns2
- do i = 1,ns1
- yj = real(j+nys-1,WP)*dx
- zk = real(k+nzs-1,WP)*dx
- U(i,j,k) = 0.0_WP
- V(i,j,k) = cos(yj/per)*sin(zk/per)
- W(i,j,k) = -sin(yj/per)*cos(zk/per)
- enddo
- enddo
- enddo
- else
- do k = 1,ns3
- do j = 1,ns2
- do i = 1,ns1
- xi = real(i+nxs-1,WP)*dx
- yj = real(j+nys-1,WP)*dx
- zk = real(k+nzs-1,WP)*dx
- U(i,j,k) = sin(xi)*cos(yj)*cos(zk)
- V(i,j,k) = -cos(xi)*sin(yj)*cos(zk)
- W(i,j,k) = 0.0
- enddo
- enddo
- enddo
- endif
-
-end subroutine tg_init
diff --git a/Code_LEGI/tools.f90 b/Code_LEGI/tools.f90
deleted file mode 100755
index 5d90f8254f7b0b88cf04bb5ff8c2849275a799ab..0000000000000000000000000000000000000000
--- a/Code_LEGI/tools.f90
+++ /dev/null
@@ -1,687 +0,0 @@
-subroutine dns_stats
-
- use solver
- use parallel
- use data
-
- implicit none
-
- real(WP), dimension(2,nx+1) :: S1,S2,S
- real(WP), dimension(ns1,ns2,ns3) :: tab,tab1
- real(WP), dimension(:,:,:), allocatable :: SCO, SCO2,dudx,dvdy,dwdz,toto
- real(WP),dimension(ns1sc,ns2sc,ns3sc) :: tabsc
- complex(WP),dimension(fns1,fns2,fns3) :: tabf
-! real(WP),dimension(ns1,ns2,ns3) :: tabx,taby,tabz
-! complex(WP),dimension(fns1,fns2,fns3) :: tabfx,tabfy,tabfz
- real(WP) :: esum, k2sum,lambda_t,Re_lambda,uturb,divumax
- real(WP) :: buf,grms,drms,lambda,buf1
-
- integer :: k,i,j,ierr,ik,nxo,nxoz
- real(WP) :: kk,umax,vmax,wmax,cos,pi,kc,eps,e_spec,zmax,zstat2,zstat,zstat2o,zstato
-
- S = 0.0_WP
- S1 = 0.0_WP
- S2 = 0.0_WP
- call u_compute
-
- pi = acos(-1.0_WP)
-! dk = 2.0_WP*pi/L
-! kc = pi*nx/L
-! eps = kc/1000000_WP
-!
-! do k = 1,fns3
-! do j = 1,fns2
-! do i = 1,fns1
-! kk= sqrt(kx(i)**2.0_WP + ky(j)**2.0_WP + kz(k)**2.0_WP)
-! ik = 1+idint(kk/dk+0.5_WP)
-! if (kk.gt.eps.and.kk.le.kc) then
-! e_spec = (real(Uk(i,j,k)*conjg(Uk(i,j,k))) + &
-! & real(Vk(i,j,k)*conjg(Vk(i,j,k))) +&
-! & real(Wk(i,j,k)*conjg(Wk(i,j,k))))
-! S1(2,ik) = S1(2,ik) + e_spec
-! S2(2,ik) = S2(2,ik) + 2*mu*kk**2.0_WP*e_spec
-! endif
-! enddo
-! enddo
-! enddo
-! do i = 1,nx+1
-! S1(1,i) = real(i-1,WP)*dk
-! S2(1,i) = real(i-1,WP)*dk
-! enddo
-! S = S1
-!
-! call MPI_ALLREDUCE(S1(2,:),S(2,:),nx+1,MPI_REAL_WP,MPI_SUM,&
-! &MPI_COMM_WORLD,ierr)
-!
-! S1 = S
-!
-! call MPI_ALLREDUCE(S2(2,:),S(2,:),nx+1,MPI_REAL_WP,MPI_SUM,&
-! &MPI_COMM_WORLD,ierr)
-!
-! S2 = S
-!
-! esum = 0.0_WP
-! k2sum = 0.0_WP
-! do k = 1,nx+1
-! kk = S(1,k)
-! esum = esum + S1(2,k)
-! k2sum = k2sum + S2(2,k)
-! enddo
-! lambda_t = sqrt(5*esum/k2sum)
-!-----urms
- tab=U**2+V**2+W**2
- buf=0.
- do k=1,ns3
- do j=1,ns2
- do i=1,ns1
- buf=buf+tab(i,j,k)
- enddo
- enddo
- enddo
- call MPI_ALLREDUCE(buf,grms,1,MPI_REAL_WP,MPI_SUM, &
- MPI_COMM_WORLD,ierr)
-! print*,"U rms =",grms/(ns1**3.)
-!-----<dudx^2>+<dvdy^2>+<dwdz^2>
- buf=0.
- tab=0.
- tabf=0.
- do k=1,fns3
- do j=1,fns2
- tabf(:,j,k) = ii*kx(:)*Uk(:,j,k)
- enddo
- enddo
- call btran_wrap(tabf,tab,ns1,ns2,ns3,fns1,fns2,fns3)
- do k=1,ns3
- do j=1,ns2
- do i=1,ns1
- buf=buf+tab(i,j,k)**2.
- enddo
- enddo
- enddo
- tab=0.
- tabf=0.
- do k=1,fns3
- do i=1,fns1
- tabf(i,:,k) = ii*ky(:)*Vk(i,:,k)
- enddo
- enddo
- call btran_wrap(tabf,tab,ns1,ns2,ns3,fns1,fns2,fns3)
- do k=1,ns3
- do j=1,ns2
- do i=1,ns1
- buf=buf+tab(i,j,k)**2.
- enddo
- enddo
- enddo
- tab=0.
- tabf=0.
- do j=1,fns2
- do i=1,fns1
- tabf(i,j,:) = ii*kz(:)*Wk(i,j,:)
- enddo
- enddo
- call btran_wrap(tabf,tab,ns1,ns2,ns3,fns1,fns2,fns3)
- do k=1,ns3
- do j=1,ns2
- do i=1,ns1
- buf=buf+tab(i,j,k)**2.
- enddo
- enddo
- enddo
- call MPI_ALLREDUCE(buf,drms,1,MPI_REAL_WP,MPI_SUM, &
- MPI_COMM_WORLD,ierr)
-!----
-!---divergence
-! -- divergences
-!- velocity
- tab1=0.
- tab=0.
- tabf=0.
- do k=1,fns3
- do j=1,fns2
- tabf(:,j,k) = ii*kx(:)*Uk(:,j,k)
- enddo
- enddo
- call btran_wrap(tabf,tab,ns1,ns2,ns3,fns1,fns2,fns3)
- tab1 = tab
- tab=0.
- tabf=0.
- do k=1,fns3
- do i=1,fns1
- tabf(i,:,k) = ii*ky(:)*Vk(i,:,k)
- enddo
- enddo
- call btran_wrap(tabf,tab,ns1,ns2,ns3,fns1,fns2,fns3)
- tab1 = tab1 + tab
- tab=0.
- tabf=0.
- do j=1,fns2
- do i=1,fns1
- tabf(i,j,:) = ii*kz(:)*Wk(i,j,:)
- enddo
- enddo
- call btran_wrap(tabf,tab,ns1,ns2,ns3,fns1,fns2,fns3)
- tab1 = tab1 + tab
- call parallel_max(maxval(abs(tab1)),divumax)
-!----
- lambda = sqrt(grms/drms)
- uturb = sqrt(grms/(3.*real(nx**3,WP)))
- Re_lambda = uturb*lambda/mu_solver
-
- call parallel_max(maxval(abs(U)),umax)
- call parallel_max(maxval(abs(V)),vmax)
- call parallel_max(maxval(abs(W)),wmax)
- call parallel_max(maxval(abs(SC)),zmax)
- tabsc=SC**2
- buf=0.
- buf1=0.
- do k=1,ns3sc
- do j=1,ns2sc
- do i=1,ns1sc
- buf=buf+tabsc(i,j,k)
- buf1=buf1+SC(i,j,k)
- enddo
- enddo
- enddo
- call MPI_ALLREDUCE(buf,zstat2,1,MPI_REAL_WP,MPI_SUM, &
- MPI_COMM_WORLD,ierr)
- call MPI_ALLREDUCE(buf1,zstat,1,MPI_REAL_WP,MPI_SUM, &
- MPI_COMM_WORLD,ierr)
- zstat=zstat/(real(nxsc**3,WP))
- zstat2=zstat2/(real(nxsc**3,WP))
- zstat2 = (zstat2 - zstat**2.)**(0.5)
-
- call parser_read('Nx filter output',nxo,0)
- if (nxo.lt.ns1sc.and.nxo.ne.0) then
- nxoz = nxo / nproc
- allocate(SCO(nxo,nxo,nxoz))
- allocate(SCO2(nxo,nxo,nxoz))
- call discretisation3(SC,SCO,ns1sc,ns2sc,ns3sc,nxo,nxo,nxoz)
- SCO2=SCO**2.0
- buf=0.
- buf1=0.
- do k=1,nxoz
- do j=1,nxo
- do i=1,nxo
- buf=buf+SCO2(i,j,k)
- buf1=buf1+SCO(i,j,k)
- enddo
- enddo
- enddo
- call MPI_ALLREDUCE(buf,zstat2o,1,MPI_REAL_WP,MPI_SUM, &
- MPI_COMM_WORLD,ierr)
- call MPI_ALLREDUCE(buf1,zstato,1,MPI_REAL_WP,MPI_SUM, &
- MPI_COMM_WORLD,ierr)
- zstato=zstato/(real(nxo**3,WP))
- zstat2o=zstat2o/(real(nxo**3,WP))
- zstat2o = (zstat2o - zstato**2.)**(0.5)
- deallocate(SCO)
- deallocate(SCO2)
- end if
-
- if (rank.eq.0) then
-! print*,grms,drms,lambda,uturb,mu_solver
- write(*,'(A10,8(E12.5,2X))') 'STEP ', sim_time,Re_lambda,uturb,umax,divumax,zmax,zstat2,zstat2o
- endif
-
- allocate(dudx(ns1,ns2,ns3))
- allocate(dvdy(ns1,ns2,ns3))
- allocate(dwdz(ns1,ns2,ns3))
- allocate(toto(ns1,ns2,ns3))
- call gradient(U,0,dudx,toto,toto)
- call gradient(V,0,toto,dvdy,toto)
- call gradient(W,0,toto,toto,dwdz)
- divumax = 0.0
- call parallel_max(maxval(abs(dudx)),divumax)
- call parallel_max(maxval(abs(dvdy)),divumax)
- call parallel_max(maxval(abs(dwdz)),divumax)
- if (rank.eq.0) print*,'DT MAX =',1.0/(4.0*divumax), divumax
- divumax = 0.0
- call parallel_max(maxval(abs(U)),divumax)
- call parallel_max(maxval(abs(V)),divumax)
- call parallel_max(maxval(abs(W)),divumax)
- if (rank.eq.0) print*,'U MAX =', divumax
-
-
-
-
-end subroutine dns_stats
-
-subroutine u_compute
-
- use solver
- use data
- use parallel
-
- implicit none
-
- real(WP) :: Uloc(ns1,ns2,ns3)
- real(WP) :: Vloc(ns1,ns2,ns3)
- real(WP) :: Wloc(ns1,ns2,ns3)
-
- call btran_wrap(Uk,Uloc,ns1,ns2,ns3,fns1,fns2,fns3)
- call btran_wrap(Vk,Vloc,ns1,ns2,ns3,fns1,fns2,fns3)
- call btran_wrap(Wk,Wloc,ns1,ns2,ns3,fns1,fns2,fns3)
-
- U = Uloc
- V = Vloc
- W = Wloc
-
-end subroutine u_compute
-
-subroutine uz_compute
-
- use solver
- use data
- use parallel
-
- implicit none
-
- real(WP) :: Uloc(ns1,ns2,ns3)
- real(WP) :: Vloc(ns1,ns2,ns3)
- real(WP) :: Wloc(ns1,ns2,ns3)
- real(WP) :: SCloc(ns1sc,ns2sc,ns3sc)
-
- call btran_wrap(Uk,Uloc,ns1,ns2,ns3,fns1,fns2,fns3)
- call btran_wrap(Vk,Vloc,ns1,ns2,ns3,fns1,fns2,fns3)
- call btran_wrap(Wk,Wloc,ns1,ns2,ns3,fns1,fns2,fns3)
- call btran_wrap(Zk,SCloc,ns1sc,ns2sc,ns3sc,fns1sc,fns2sc,fns3sc)
-
- U = Uloc
- V = Vloc
- W = Wloc
- SC = SCloc
-
-end subroutine uz_compute
-
-
-subroutine get_spectrum(Bdummy,nx1,nx2,nx3,fnx1,fnx2,fnx3,L,Sg,Sg1)
-
- use transform
- use precision
- use parallel
-
- implicit none
-! include 'fftw3.f'
-
- integer :: nx1,nx2,nx3
- integer :: fnx1,fnx2,fnx3
- integer :: fn1zs,fn1ze,fn1ys,fn1ye,fn1xs,fn1xe
- real(WP), dimension(2,nx1+1) :: S, Sg, Sg1
- real(WP), dimension(nx1,nx2,nx3) :: Bdummy
- real(WP) :: ke,kd,ks,dk,ksk0ratio,kc,kcksratio,kk,kx,ky,kz,kk2
-
-
- real(WP), dimension(:,:,:), pointer :: Rbuf
-
- real(WP), dimension(:,:,:), pointer :: in
- complex(WP), dimension(:,:,:), pointer :: out
-
- integer :: ierr
- integer :: i,j,k,ik,iunit,gg(3)
- integer :: il,jl,kl,nkk
- complex(WP) :: ii=(0.0_WP,1.0_WP)
- real(WP) :: rand,pi,eps,L,gmax
-
- integer(KIND=8) :: plan_3d
-
- real(WP), dimension(nx1+1) :: nnodes
- real(WP) :: node_density
-
-
-
-
- allocate(Rbuf(fnx1,fnx2,fnx3))
- allocate(A(nx1,nx2,nx3))
- allocate(B(fnx1,fnx2,fnx3))
- allocate(C(fnx1,fnx2,fnx3))
- allocate(D(fnx1,fnx3,fnx2))
-
-
- do k = 1,nx3
- do j = 1,nx2
- do i = 1,nx1
- A(i,j,k) = Bdummy(i,j,k)
- enddo
- enddo
- enddo
-
- call forward_transform(nx1,nx2,nx3,fnx1,fnx2,fnx3)
-
- do k = 1,fnx3
- do j = 1,fnx2
- do i = 1,fnx1
- B(i,j,k) = B(i,j,k)/real(nx1**3.0,WP)
- Rbuf(i,j,k) = sqrt(real(B(i,j,k)*conjg(B(i,j,k)),WP))
- enddo
- enddo
- enddo
-
-
-
-
- Sg = 0.0_WP
- Sg1 = 0.0_WP
- nnodes = 0.0_WP
-
- ! Create pi
- pi = acos(-1.0_WP)
-
- ! =================
- ! Velocity Spectrum
-
- ! Spectrum computation
-
- dk = 2.0_WP*pi/L
- kc = pi*nx1/L
- eps=kc/1000000.0_WP
-
- nkk = nx1/2+1
- fn1zs = 1
- fn1ze = fnx3
- fn1ys = 1 + (rank)*fnx2
- fn1ye = (rank+1)*fnx2
- fn1xs = 1
- fn1xe = nkk
-
- do k = fn1zs,fn1ze
- do j = fn1ys,fn1ye
- do i = fn1xs,fn1xe
- il = i-fn1xs+1
- jl = j-fn1ys+1
- kl = k-fn1zs+1
- ! Wavenumbers
- kx=real(i-1,WP)*dk
-! if (i.gt.(nkk)) kx=-real(nx1-i+1,WP)*dk
- ky=real(j-1,WP)*dk
- if (j.gt.nkk) ky=-real(nx1-j+1,WP)*dk
- kz=real(k-1,WP)*dk
- if (k.gt.nkk) kz=-real(nx1-k+1,WP)*dk
- kk=sqrt(kx**2+ky**2+kz**2)
- ! Spectrum
- ik=1+idint(kk/dk+0.5_WP)
-!!$ nnodes(ik) = nnodes(ik) + 1.0_WP
- if ((kk.gt.eps).and.(kk.le.kc)) then
-!!$ if (i.gt.1) then
- Sg(2,ik)=Sg(2,ik)+(Rbuf(il,jl,kl)**2)
- Sg1(2,ik) = Sg1(2,ik) + kk**2.0_WP*(Rbuf(il,jl,kl)**2)
-!!$ else
-!!$ S(2,ik)=S(2,ik)+0.5_WP*(Rbuf(il,jl,kl)**2)/dk
-!!$ endif
- end if
- end do
- end do
- end do
-
-
- do ik=1,nx1+1
- Sg(1,ik)=real(dk*(ik-1),WP)
- Sg1(1,ik)=real(dk*(ik-1),WP)
- end do
-
-
-
- deallocate(Rbuf)
-
-
- deallocate(A)
- deallocate(B)
- deallocate(C)
- deallocate(D)
-
-
-end subroutine get_spectrum
-
-subroutine get_dns_numbers(iinfo)
-
- use parallel
- use data
- implicit none
-
- real(WP) :: pi
- real(WP) :: ke,mu_cin,dx
- real(WP) :: kcin,epsi,l11,lt,re_turb,tau_epsi,l_k,tau_k
-
- real(WP) :: keta, L_large,dk,eta,dissipation,tke,Rlambda
- real(WP), dimension(:,:), pointer :: S1,S2,S3,Sg
- real(WP), dimension(:,:), pointer :: S11,S21,S31,Sg1
-
-
-
- integer :: i, iunit, ierr, iinfo
-
-
-
-
-
- allocate(S1(2,nx+1),S2(2,nx+1),S3(2,nx+1),Sg(2,nx+1))
- allocate(S11(2,nx+1),S21(2,nx+1),S31(2,nx+1),Sg1(2,nx+1))
-
- Sg = 0.0_WP
-
- S1 = 0.0_WP
- S2 = 0.0_WP
- S3 = 0.0_WP
-
-
- call get_spectrum(V,ns1,ns2,ns3,fns1,fns2,fns3,L,S1,S11)
- call get_spectrum(U,ns1,ns2,ns3,fns1,fns2,fns3,L,S2,S21)
- call get_spectrum(W,ns1,ns2,ns3,fns1,fns2,fns3,L,S3,S31)
-
- Sg(1,:) = S1(1,:)
- Sg(1,:) = S11(1,:)
-
- S1 = S1 + S2 + S3
- S11 = S11 + S21 + S31
-
- call MPI_ALLREDUCE(S1(2,:),Sg(2,:),nx+1,MPI_REAL_WP,MPI_SUM,&
- &MPI_COMM_WORLD,ierr)
-
- call MPI_ALLREDUCE(S11(2,:),Sg1(2,:),nx+1,MPI_REAL_WP,MPI_SUM,&
- &MPI_COMM_WORLD,ierr)
-
- if (rank.eq.0) then
- iunit = iopen()
- open(iunit,file=trim(adjustl(spfilename)),form='formatted')
-
- do i = 1,nx+1
- if ((Sg(1,i).ne.0.0_WP).and.(Sg(2,i).ne.0.0_WP)) then
- write(11,*) Sg(1,i), Sg(2,i)
- endif
- enddo
- close(iclose(iunit))
- endif
-
- call parser_read('Kmax eta', keta)
-
-
-
- pi = acos(-1.0_WP)
- dx = L/real(nx,WP)
- tke = 0.0_WP
- dissipation = 0.0_WP
-
- do i = 1,nx+1
- tke = tke + Sg(2,i)
- dissipation = dissipation + 2*mu*Sg1(2,i)
- enddo
-
- Ut = sqrt(tke/1.5_WP)
- eta = (2.0_WP*keta)/real(nx,WP)
- re_turb = tke**2.0/(dissipation*mu)
- Rlambda = sqrt(20.0_WP/3.0_WP*re_turb)
-
- lt = eta*(3.0_WP/20.0_WP*Rlambda*Rlambda)**(3.0/4.0)
- L11 = lt*0.43
-
-
- ke = 1.3_WP/L11
- dk = 2.0_WP*pi/L
-
- tau_epsi = tke/dissipation
- tau_k = sqrt(mu/dissipation)
-
-
-
- if (rank.eq.0.and.iinfo.eq.1) then
-
- write(*,*)
- write(*,*) ' ======================================== '
- write(*,*)' Debugging turbulent values '
- write(*,*)' ---------------------------------------- '
- if (trim(spectrum).eq.'PP') then
- write(*,*)' -Spectrum type ----------> Passot-Pouquet'
- else if (trim(spectrum).eq.'VKP') then
- write(*,*)' -Spectrum type ----------> Von Karman-Pao'
- end if
- write(*,*)' Viscosity '
- write(*,*)' mu ------->', mu
- write(*,*)' -Turbulent Reynolds '
- write(*,*)' Re_t --------> ', re_turb
- write(*,*)' -Turbulent kinetic energy '
- write(*,*)' k -----------> ', tke
- write(*,*)' -Turbulent dissipation rate '
- write(*,*)' epsilon -----> ', dissipation
- write(*,*)' -Size of the biggest eddy '
- write(*,*)' l_t ---------> ', lt
- write(*,*)' C1 ----------> ', L/lt
- write(*,*)' -Eddy turn over time '
- write(*,*)' tau ---------> ', tau_epsi
- write(*,*)' -Kolmogorov scale '
- write(*,*)' l_k ---------> ', eta
- write(*,*)' C2 ----------> ', eta/dx
- write(*,*)' -Kolmogorov time scale '
- write(*,*)' tau_k -------> ', tau_k
- write(*,*)' -Reynolds lambda '
- write(*,*)' Re_lambda ---> ', Rlambda
- if (trim(spectrum).eq.'PP') then
- write(*,*)' -Integral length scale '
- write(*,*)' Lii --------> ', l11
- write(*,*)' -Turbulent Reynolds based on Lii '
- write(*,*)' Re_Lii -----> ', Ut*l11/mu
- end if
- write(*,*)' ======================================== '
-
- endif
-
- deallocate(S1,S2,S3,Sg)
- deallocate(S11,S21,S31,Sg1)
- allocate(S3(2,nxsc+1),Sg(2,nxsc+1))
- allocate(S31(2,nxsc+1),Sg1(2,nxsc+1))
- S3 = 0.0
- S31 = 0.0
- call get_spectrum(SC,ns1sc,ns2sc,ns3sc,fns1sc,fns2sc,fns3sc,L,S3,S31)
- Sg(1,:) = S3(1,:)
- Sg(1,:) = S31(1,:)
- call MPI_ALLREDUCE(S3(2,:),Sg(2,:),nxsc+1,MPI_REAL_WP,MPI_SUM,&
- &MPI_COMM_WORLD,ierr)
-
- call MPI_ALLREDUCE(S31(2,:),Sg1(2,:),nxsc+1,MPI_REAL_WP,MPI_SUM,&
- &MPI_COMM_WORLD,ierr)
-
-
- if (rank.eq.0) then
- iunit = iopen()
- open(iunit,file=trim(adjustl(spfilename2)),form='formatted')
-
- do i = 1,nxsc+1
- if ((Sg(1,i).ne.0.0_WP).and.(Sg(2,i).ne.0.0_WP)) then
- write(11,*) Sg(1,i), Sg(2,i)
- endif
- enddo
- close(iclose(iunit))
- endif
- deallocate(S3,Sg)
- deallocate(S31,Sg1)
-
-
-end subroutine get_dns_numbers
-
-
-subroutine tg_stats
-
- use solver
- use parallel
- use data
-
- implicit none
-
- real(WP) :: umax,vmax,wmax,nmax
- real(WP),dimension(2,nx+1) :: S1,S
- real(WP) :: esum, k2sum,lambda_t,Re_lambda,uturb
-
- integer :: k,ierr
- real(WP) :: kk
-
-
-
- S = 0.0_WP
- S1 = 0.0_WP
-
- call u_compute
- call get_spectrum(U,ns1,ns2,ns3,L,S1)
- S = S1
- call get_spectrum(V,ns1,ns2,ns3,L,S1)
- S = S + S1
- call get_spectrum(W,ns1,ns2,ns3,L,S1)
- S = S + S1
-
- S(1,:) = S1(1,:)
- S1 = S
-
- call MPI_ALLREDUCE(S1(2,:),S(2,:),nx+1,MPI_REAL_WP,MPI_SUM,&
- &MPI_COMM_WORLD,ierr)
-
- esum = 0.0_WP
- k2sum = 0.0_WP
- do k = 1,nx+1
- kk = S1(1,k)
- esum = esum + S(2,k)
- k2sum = k2sum + S(2,k)*S1(1,k)**2.0
- enddo
- lambda_t = sqrt(5*esum/k2sum)
- uturb = sqrt(2.0_WP/3.0_Wp*esum)
- if (mu.gt.0.0_WP) then
- Re_lambda = lambda_t*uturb/mu
- else
- Re_lambda = 0.0_WP
- endif
-
-
- call parallel_max(maxval(abs(U)),umax)
- call parallel_max(maxval(abs(V)),vmax)
- call parallel_max(maxval(abs(W)),wmax)
-
- if (rank.eq.0) then
- write(*,'(A7,4(E12.5,3X),2E15.8)') 'STEP ', sim_time, umax, vmax,wmax,k2sum,esum
- endif
-
-
-
-end subroutine tg_stats
-
-
-real(WP) function spec(ka,kb,ke)
-
- use precision
-
- implicit none
- real(WP) :: e,dk,ka,kb,ke,integ,k
- integer :: i,n
-
- n = 1000
-
- dk = (kb-ka)/real(n,WP)
-
- integ = 0.0_WP
- k = ka
- do i =1,n
- k = k + dk
- integ = integ + (k/ke)**4.0_WP*exp(-2.0_WP*(k/ke)**2.0_WP)*dk
- enddo
- spec = integ/(kb-ka)
-
-end function spec
-
-
-
diff --git a/Code_LEGI/tout.f90 b/Code_LEGI/tout.f90
deleted file mode 100644
index ae6dc872632129621edbe5cbeabcc806385e6194..0000000000000000000000000000000000000000
--- a/Code_LEGI/tout.f90
+++ /dev/null
@@ -1,537 +0,0 @@
-module x_advec_m
-
- use solver
- use data
-
- implicit none
-
- integer :: npart, ntag_total, npg
- real(WP) :: xmin, ymin, zmin, xmax, ymax, zmax, cfl
- integer, dimension(:), allocatable :: itype
- integer, dimension(:), allocatable :: itype_aux
- integer, dimension(:), allocatable :: itag
- integer, dimension(:), allocatable :: icfl
- real(WP), dimension(:), allocatable :: up
- real(WP), dimension(:), allocatable :: up_aux
- real(WP), dimension(:), allocatable :: xp
- real(WP), dimension(:), allocatable :: xp0
- real(WP), dimension(:), allocatable :: xp_aux
- real(WP), dimension(:), allocatable :: vx
- real(WP), dimension(:), allocatable :: vx_aux
-
- real(WP) :: circlim
-
-end module x_advec_m
-
-
-
-subroutine x_advec_init
-
- use x_advec_m
-
- implicit none
-
- npg = nxsc !100000
-
- allocate(up(npg))
- allocate(up_aux(npg))
- allocate(xp(npg)) !!-> code original npg = 256 mais ca marche pas
- allocate(xp0(npg))
- allocate(xp_aux(npg))
- allocate(vx(npg))
- allocate(vx_aux(npg))
- allocate(itype(npg))
- allocate(itype_aux(npg))
- allocate(itag(npg))
- allocate(icfl(npg))
-
- up = 0.0
- up_aux = 0.0
- xp = 0.0
- xp0 = 0.0
- xp_aux = 0.0
- vx = 0.0
- vx_aux = 0.0
- cfl = 0.0
-
- itype = 0
- itype_aux = 0
- itag = 0
- icfl = 0
-
- npart = 0
- ntag_total = 0
-
- xmin = 0.
- ymin = 0.
- zmin = 0.
- xmax = L
- ymax = L
- zmax = L
-
- circlim = 10**(-5)
-
-end subroutine x_advec_init
-
-
-
-subroutine x_advec
-
- use x_advec_m
-
- implicit none
-
- real(WP) :: dx, yy, zz
- integer :: i,j,k,np,n, jr, kr, np_aux, ini, ntag
-
- dx = L/nxsc
- cfl = dt/dx
-
- print*,"dt =",dt
-
- npart = 0
- ntag_total = 0
- ntag = 0
-
- do k=1,nxsc
- zz=xmin+float(k-1)*dx
- do j=1,nxsc
- np=0
- yy=xmin+float(j-1)*dx
- do i=1,nxsc
- if (abs(SC(i,j,k)).gt.circlim) then
- np=np+1
- up(np)=SC(i,j,k)
- xp(np)=xmin+float(i-1)*dx
- end if
- end do
- if (np.ne.0) then
- call velox_x(np,j,k)
- do n=1,np
- xp0(n)=xp(n)
- xp(n)=xp(n)+0.5*dt*vx(n)
- if (xp(n).gt.xmax) xp(n)=xp(n)-xmax+xmin
- if (xp(n).lt.xmin) xp(n)=xp(n)+xmax-xmin
- end do
- call velox_x(np,j,k)
-
-!! debut modif
-
- call tag_particles(np,np_aux,ntag)
- ! test
- !itype(1:np_aux) = 1
-
-! np integer: deja defini (input) - local
-! np_aux integer: deja defini (output) - local
-! ntag integer: deja defini (output) - local
-! np_bl=1 --> supprimer de l'appel
-! icfl tablo integer: deja defini - common --> supprimer de l'appel
-! itype tablo integer: deja defini - common --> supprimer de l'appel
-! itype_aux tablo integer: deja defini - common --> supprimer de l'appel
-! itag tablo integer: deja defini - common --> supprimer de l'appel
-! xp_aux tablo real integer: deja defini - common --> supprimer de l'appel
-! up_aux tablo real integer: deja defini - common --> supprimer de l'appel
-! vx_aux tablo real integer: deja defini - common --> supprimer de l'appel
-
-! ---- > trouver les dimension max des tablo
-! ---- > trouver si les tablo doivent etre declarer en local ou en common
-
- if (ntag.ne.0) then
- do n=1,ntag
- ini=itag(n)
- xp(ini)=xp0(ini)+dt*vx(ini)
- if (xp(ini).gt.xmax) xp(ini)=xp(ini)-xmax+xmin
- end do
- end if
-
- do n=1,np_aux
- xp_aux(n)=xp_aux(n)+dt*vx_aux(n)
- if (xp_aux(n).gt.xmax) xp_aux(n)=xp_aux(n)-xmax+xmin
- if (xp_aux(n).lt.xmin) xp_aux(n)=xp_aux(n)+xmax-xmin
- end do
- jr=j
- kr=k
- call remeshx(np_aux,jr,kr)
- if (ntag.ne.0) call remeshx_tag(ntag,jr,kr)
-
-!! fin modif
-
- npart=npart+np
- end if
- end do
- end do
-
- print*, 'NPART, NTAG ', npart,ntag_total
- print*,'ntag x_advec :', ntag
-
-
-end subroutine x_advec
-
-
-
-subroutine velox_x(np,j,k)
-
- use x_advec_m
-
- implicit none
-
- integer :: np, j, k, i, nx3, ny3, nz3, jp1, jp2, kp1, kp2, ip1, ip2
- real(WP) :: dx3, dy3, dz3, dxinv, yy, zz, x0, y0, z0, dx2
- real(WP) :: yy1, yy2, zz1, zz2, b1, b2, c1, c2, a1, a2
- real(WP) :: x, xx1, xx2
-
- do i=1,np
- vx(i)=0.
- end do
-
- nx3=nx
- ny3=nx3
- nz3=nx3
- dx3=xmax/float(nx3)
- dy3=dx3
- dz3=dx3
-
- dxinv=1./dx3
-
- x0=xmin
- y0=ymin
- z0=zmin
-
- dx2 = L/nxsc
-
- yy=x0+float(j-1)*dx2
- zz=x0+float(k-1)*dx2
-
- jp1 = int((yy)/dx3)
- jp2 = jp1 + 1
- kp1 = int((zz)/dx3)
- kp2 = kp1 + 1
- yy1 = (yy-float(jp1)*dx3)/dx3
- yy2 = 1.0 - yy1
- zz1 = (zz-float(kp1)*dx3)/dx3
- zz2 = 1.0 - zz1
- b1=yy2
- b2=yy1
- c1=zz2
- c2=zz1
-
- jp1=mod(jp1+nx3,nx3) +1
- jp2=mod(jp2+nx3,nx3) +1
- kp1=mod(kp1+nx3,nx3) +1
- kp2=mod(kp2+nx3,nx3) +1
-
- do i = 1,np
-
- x = xp(i)
-
- ip1 = int((x-x0)*dxinv)
- ip2 = ip1 + 1
-
- xx1 = (x - float(ip1)*dx3-x0)*dxinv
- xx2=1-xx1
-
- ip1=mod(ip1+nx3,nx3) +1
- ip2=mod(ip2+nx3,nx3) +1
-
- a1 = xx2
- a2 = xx1
-
- vx(i)= vx(i) + U(ip1,jp1,kp1)*a1*b1*c1
- vx(i)= vx(i) + U(ip2,jp1,kp1)*a2*b1*c1
- vx(i)= vx(i) + U(ip1,jp2,kp1)*a1*b2*c1
- vx(i)= vx(i) + U(ip2,jp2,kp1)*a2*b2*c1
- vx(i)= vx(i) + U(ip1,jp1,kp2)*a1*b1*c2
- vx(i)= vx(i) + U(ip2,jp1,kp2)*a2*b1*c2
- vx(i)= vx(i) + U(ip1,jp2,kp2)*a1*b2*c2
- vx(i)= vx(i) + U(ip2,jp2,kp2)*a2*b2*c2
-
- end do
-
-end subroutine velox_x
-
-subroutine remeshx(np1,jj,kk)
-
- use x_advec_m
-
- implicit none
-
- integer :: np1, jj, kk
- integer :: i, nx2, n, ip0, ip1, ip2, k, j
- real(WP) :: dxinv, dx2, x0, g1, x, xx0, xx1, xx2, a0, a1, a2
-
- nx2 = nxsc
- dx2 = L/nx2
-
- dxinv=1./dx2
-
- do i=1,nx2
- SC(i,jj,kk)=0.
- enddo
-
- x0=xmin
-
- do n = 1,np1
- g1 = up_aux(n)
- x = xp_aux(n)
-
- if (itype(n).eq.0) then
- ip1 = int((x-x0)*dxinv)
- ip0 = ip1 - 1
- ip2 = ip1 + 1
-
- xx1 = (x - float(ip1)*dx2-x0)*dxinv
- xx0=xx1+1
- xx2=1-xx1
-
- ip1=mod(ip1+nx2,nx2) +1
- ip0=mod(ip0+nx2,nx2) +1
- ip2=mod(ip2+nx2,nx2) +1
-
- a0=-0.5*xx1*xx2
- a1=1.-xx1**2
- a2=0.5*xx0*xx1
-
- SC(ip0,jj,kk) = SC(ip0,jj,kk) + g1*a0
- SC(ip1,jj,kk) = SC(ip1,jj,kk) + g1*a1
- SC(ip2,jj,kk) = SC(ip2,jj,kk) + g1*a2
-
- else
-
- ip1 = nint((x-x0)*dxinv)
- ip0 = ip1 - 1
- ip2 = ip1 + 1
-
- xx1 = (x - float(ip1)*dx2-x0)*dxinv
- xx0=xx1+1
- xx2=1-xx1
-
- ip1=mod(ip1+nx2,nx2) +1
- ip0=mod(ip0+nx2,nx2) +1
- ip2=mod(ip2+nx2,nx2) +1
-
- a0=-0.5*xx1*xx2
- a1=1.-xx1**2
- a2=0.5*xx0*xx1
-
- SC(ip0,jj,kk) = SC(ip0,jj,kk) + g1*a0
- SC(ip1,jj,kk) = SC(ip1,jj,kk) + g1*a1
- SC(ip2,jj,kk) = SC(ip2,jj,kk) + g1*a2
-
- end if
- end do
-
-!!! go to 222 !! -> ca veut dire quoi goto ?
-!!! do k=3,nx2-2
-!!! do j=1,nx2
-!!! do i=1,nx2
-!!! if (SC(i,j,k).gt.1.2) then
-!!! print*,'BOUM', i,j,k,SC(i,j,k)
-!!! goto 222
-!!! end if
-!!! end do
-!!! end do
-!!! end do
-
-end subroutine remeshx
-
-subroutine tag_particles(npt,npart_aux,ntag)
-
- use x_advec_m
-
- implicit none
-
- integer :: npt, npart_aux, ntag
-
- integer :: ntype(npg),ncfl(npg),npart_bl(npg),i_nbl(npg)
- real(WP) :: amin_lambda(npg), cflm
-
- real(WP) :: x0, dx, dx_bl, dx_bl_inv
- integer :: nblock, m, nbl, i, j, ini, jj, jc
-
- x0=xmin
-
- cflm = cfl
-
-
- m = 2 !np_bl+1
- nblock=nxsc/(m)
- dx = L/nxsc
- dx_bl=float(m)*dx
- dx_bl_inv=1./dx_bl
-
- do nbl=1,nblock
- amin_lambda(nbl)=111.
- npart_bl(nbl)=0
- i_nbl(nbl)=0
- enddo
-
- do i=1,npt
- nbl=1+int((xp0(i)-x0+0.00001)*dx_bl_inv)
- amin_lambda(nbl)=amin1(amin_lambda(nbl),vx(i)*cflm)
- npart_bl(nbl)=npart_bl(nbl)+1
- i_nbl(nbl)=i
- enddo
-
- do nbl=1,nblock-1
- if (i_nbl(nbl).ne.0) then
- ini=i_nbl(nbl)
- if ((ini.lt.npart).and.(xp0(ini+1).lt.xp0(ini)+1.5*dx)) then
- amin_lambda(nbl)=amin1(amin_lambda(nbl),vx(ini+1)*cflm)
- end if
- end if
- end do
-
- nbl=nblock
- if (i_nbl(nbl).ne.0) then
- if ((xp0(npt).ge.xmax-1.5*dx).and.(xp0(1).lt.xmin+0.5*dx)) then
- amin_lambda(nbl)=amin1(amin_lambda(nbl),vx(1)*cflm)
- end if
- end if
-
- do nbl=1,nblock
- if (amin_lambda(nbl).lt.nint(amin_lambda(nbl))) then
- ntype(nbl)=1
- ncfl(nbl)=nint(amin_lambda(nbl))
- else
- ntype(nbl)=0
- ncfl(nbl)=int(amin_lambda(nbl))
- if (amin_lambda(nbl).lt.0) ncfl(nbl)=int(amin_lambda(nbl))-1
- endif
- end do
-
- do i=1,npt
- nbl=1+int((xp0(i)-x0+0.00001)*dx_bl_inv)
- itype(i)=ntype(nbl)
- icfl(i)=ncfl(nbl)
- if (itype(i).ne.0.and.itype(i).ne.1) then
- print*,i,itype(i)
- print*,nbl,ntype(nbl),nblock
- print*,x0,xmin
- stop
- end if
- end do
-
- ntag=0
- npart_aux=0
- j=2
- jc=0
- do i=2,npt-1
- j=j+jc
- if (j.lt.npt) then
- jj=j+1
- if ((icfl(j).ne.icfl(jj)).and.(itype(j).ne.itype(jj)).and.(xp0(jj).le.xp0(j)+1.5*dx)) then
- ntag=ntag+1
- itag(ntag)=j
- ntag=ntag+1
- itag(ntag)=j+1
- jc=2
- else
- npart_aux=npart_aux+1
- xp_aux(npart_aux)=xp0(j) !xp(j)
- up_aux(npart_aux)=up(j)
- vx_aux(npart_aux)=vx(j)
- itype_aux(npart_aux)=itype(j)
- jc=1
- end if
- end if
- end do
-
- if (npt.ge.1) then
-
- if ((icfl(1).ne.icfl(npt)).and.(itype(1).ne.itype(npt)) &
- & .and.(xp0(npt).ge.xp0(1)+(float(nxsc)-1.5)*dx) &
- & .and.(itag(ntag).ne.npt)) then
- ntag=ntag+1
- itag(ntag)=npt
- ntag=ntag+1
- itag(ntag)=1
- else
- npart_aux=npart_aux+1
- xp_aux(npart_aux)=xp0(1) !xp(1)
- up_aux(npart_aux)=up(1)
- vx_aux(npart_aux)=vx(1)
- itype_aux(npart_aux)=itype(1)
- if (npt.gt.1) then
- npart_aux=npart_aux+1
- xp_aux(npart_aux)=xp0(npt) !xp(npt)
- up_aux(npart_aux)=up(npt)
- vx_aux(npart_aux)=vx(npt)
- itype_aux(npart_aux)=itype(npt)
- end if
- end if
- end if
-
-end subroutine tag_particles
-
-subroutine remeshx_tag(ntag,jj,kk)
-
-
- use x_advec_m
-
- implicit none
-
- integer :: ntag, jj, kk
- integer :: i, nx2, n, ip0, ip1, ip2, k, j, ini, jp1, ip3, ip4
- real(WP) :: dxinv, dx2, x0, g1, x, xx0, xx1, xx2, a0, a1, a2, b1, b2, y, u1, u2, yy0, yy1, yy2
-
- nx2 = nxsc
- dx2 = L/nx2
-
- dxinv=1./dx2
- x0=xmin
-
- do n=1,ntag-1,2
- i=itag(n)
- ini=itag(n+1)
- x=xp(i)
- y=xp(ini)
- u1=up(i)
- u2=up(ini)
- if (itype(i).eq.0) then
- ip1 = int((x-x0)*dxinv)
- jp1 = nint((y-x0)*dxinv)
- xx1 = (x - float(ip1)*dx2-x0)*dxinv
- yy1 = (y - float(jp1)*dx2-x0)*dxinv
- xx0=xx1+1
- xx2=1-xx1
- yy0=yy1+1
- yy2=1-yy1
- ip0=ip1-1
- ip2=ip1+1
- ip3=ip1+2
- ip4=ip1+3
- ip1=mod(ip1+nx2,nx2) +1
- ip0=mod(ip0+nx2,nx2) +1
- ip2=mod(ip2+nx2,nx2) +1
- ip3=mod(ip3+nx2,nx2) +1
- ip4=mod(ip4+nx2,nx2) +1
- a0=-xx1*xx2/2.
- a1=xx0*xx2
- b1=yy0*yy2
- b2=yy0*yy1/2.
- SC(ip0,jj,kk)=SC(ip0,jj,kk)+a0*u1
- SC(ip1,jj,kk)=SC(ip1,jj,kk)+a1*u1+(1.+yy1-b1-b2)*u2
- SC(ip2,jj,kk)=SC(ip2,jj,kk)+xx1*u1-yy1*u2
- SC(ip3,jj,kk)=SC(ip3,jj,kk)+(1.-a0-a1-xx1)*u1+b1*u2
- SC(ip4,jj,kk)=SC(ip4,jj,kk)+b2*u2
- else
- ip1 = nint((x-x0)*dxinv)
- jp1 = int((y-x0)*dxinv)
- xx1 = (x - float(ip1)*dx2-x0)*dxinv
- yy1 = (y - float(jp1)*dx2-x0)*dxinv
- xx2=1-xx1
- yy0=yy1+1
- ip0=ip1-1
- ip2=ip1+1
- ip1=mod(ip1+nx2,nx2) +1
- ip0=mod(ip0+nx2,nx2) +1
- ip2=mod(ip2+nx2,nx2) +1
- a0=-0.5*xx1*xx2
- b2=0.5*yy0*yy1
- SC(ip0,jj,kk)=SC(ip0,jj,kk)+a0*u1
- SC(ip1,jj,kk)=SC(ip1,jj,kk)+(1.-a0)*u1+(1.-b2)*u2
- SC(ip2,jj,kk)=SC(ip2,jj,kk)+b2*u2
- endif
- enddo
-
-end subroutine remeshx_tag
diff --git a/Code_LEGI/transforms.f90 b/Code_LEGI/transforms.f90
deleted file mode 100755
index 3c2d56b1a92eea726f87579d8e91cf50153f3b88..0000000000000000000000000000000000000000
--- a/Code_LEGI/transforms.f90
+++ /dev/null
@@ -1,329 +0,0 @@
-module transform
-
- use precision
- use parallel
- implicit none
- include 'fftw3.f'
-
- real(WP), dimension(:,:,:), pointer :: A !_real (ns1,ns2,ns3)
- complex(WP), dimension(:,:,:), pointer :: B !_complex (fns1,fns2,fns3)
- complex(WP), dimension(:,:,:), pointer :: C !_dummy (fns1,fns2,fns3)
- complex(WP), dimension(:,:,:), pointer :: D !_dummy (fns1,fns3,fns2)
-end module transform
-
-
-subroutine forward_transform(n1,n2,n3,fn1,fn2,fn3)
-
- use transform
- implicit none
-
- integer :: nsize(2),idim,istride,idist,ostride,odist
- integer :: idim2,istride2,idist2,ostride2,odist2
- integer :: inem(3),onem(3),howmany
- integer :: n1,n2,n3,fn1,fn2,fn3
- integer(KIND=8) :: plan_mf1,plan_mf2
-
-
- integer, parameter :: NULL = 0
-
- integer :: nsize1
-
- idim = 2
- nsize(1) = n1
- nsize(2) = n2
- inem(1) = n1
- inem(2) = n2
- inem(3) = n3
- istride = 1
- idist = n1*n2
-
- onem(1) = fn1
- onem(2) = fn3
- onem(3) = fn2
- ostride = 1
- odist = fn1*fn3
-
- call dfftw_plan_many_dft_r2c(plan_mf1,idim,nsize,n3,A,inem,istride,idist,D,onem,ostride,odist,FFTW_ESTIMATE)
- call dfftw_execute_dft_r2c(plan_mf1,A,D)
- call dfftw_destroy_plan(plan_mf1)
-
- call transpose_forward(n1,n2,n3,fn1,fn2,fn3) !(D,B)
-
- idim2 = 1
- nsize1 = fn3
- howmany = fn1*fn2
-
- inem(1) = fn1
- inem(2) = fn2
- inem(3) = fn3
- istride2 = fn1*fn2
- idist2 = 1
-
- onem(1) = fn1
- onem(2) = fn2
- onem(3) = fn3
- ostride2 = fn1*fn2
- odist2 = 1
-
- call dfftw_plan_many_dft(plan_mf2,idim2,nsize1,howmany,B,inem,istride2,idist2,B,onem,ostride2,&
- &odist2,FFTW_FORWARD,FFTW_ESTIMATE)
- call dfftw_execute_dft(plan_mf2,B,B)
- call dfftw_destroy_plan(plan_mf2)
-
-end subroutine forward_transform
-
-
-subroutine backward_transform(n1,n2,n3,fn1,fn2,fn3)
-
- use transform
- implicit none
- integer :: k,j,i
- integer :: nsize(2),idim,istride,idist,ostride,odist
- integer :: idim2,istride2,idist2,ostride2,odist2
- integer :: inem(3),onem(3),howmany,nsize1
- integer :: n1,n2,n3,fn1,fn2,fn3
- integer(KIND=8) :: plan_mb1,plan_mb2
-
-
- idim2 = 1
- nsize1 = fn3
- howmany = fn1*fn2
-
- inem(1) = fn1
- inem(2) = fn2
- inem(3) = fn3
- istride2 = fn1*fn2
- idist2 = 1
-
- onem(1) = fn1
- onem(2) = fn2
- onem(3) = fn3
- ostride2 = fn1*fn2
- odist2 = 1
-
- call dfftw_plan_many_dft(plan_mb1,idim2,nsize1,howmany,B,inem,istride2,idist2,B,onem,ostride2,&
- &odist2,FFTW_BACKWARD,FFTW_ESTIMATE)
- call dfftw_execute_dft(plan_mb1,B,B)
- call dfftw_destroy_plan(plan_mb1)
-
- call transpose_backward(n1,n2,n3,fn1,fn2,fn3) !(B,D)
-
- idim = 2
- nsize(1) = n1
- nsize(2) = n2
- inem(1) = n1
- inem(2) = n2
- inem(3) = n3
- istride = 1
- idist = n1*n2
-
- onem(1) = fn1
- onem(2) = fn3
- onem(3) = fn2
- ostride = 1
- odist = fn1*fn3
-
- call dfftw_plan_many_dft_c2r(plan_mb2,idim,nsize,fn2,D,onem,ostride,odist,A,inem,istride,idist,FFTW_ESTIMATE)
- call dfftw_execute_dft_c2r(plan_mb2,D,A)
- call dfftw_destroy_plan(plan_mb2)
-
-end subroutine backward_transform
-
-
-
-subroutine transpose_forward(n1,n2,n3,fn1,fn2,fn3)
-
-
-
- use transform
- implicit none
-
- integer :: n1,n2,n3,fn1,fn2,fn3
- integer :: scount,ierr,i,k,ki,jstart,jend,j
-
- if (nproc.gt.1) then
-
- scount = fn1*fn2*fn2
-
-
- do i = 1,nproc
- do k = 1,fn2
- ki = (i-1)*fn2 + k
- jstart = (i-1)*fn2 + 1
- jend = i*fn2
-
- C(1:fn1,1:fn2,ki) = D(1:fn1,jstart:jend,k)
- enddo
- enddo
-
-
- call MPI_ALLTOALL(C,scount,MPI_COMPLEX_WP,B,scount,MPI_COMPLEX_WP,MPI_COMM_WORLD,ierr)
- else
- do k = 1,fn3
- do j = 1,fn2
- do i = 1,fn1
- B(i,j,k) = D(i,j,k)
- enddo
- enddo
- enddo
- endif
-end subroutine transpose_forward
-
-subroutine transpose_backward(n1,n2,n3,fn1,fn2,fn3)
-
-
-
- use transform
- implicit none
-
- integer :: n1,n2,n3,fn1,fn2,fn3
- integer :: scount,ierr,i,k,ki,jstart,jend,j
-
- if (nproc.gt.1) then
-
- scount = fn1*fn2*fn2
-
-
- call MPI_ALLTOALL(B,scount,MPI_COMPLEX_WP,C,scount,MPI_COMPLEX_WP,MPI_COMM_WORLD,ierr)
-
-
- do i = 1,nproc
- do k = 1,fn2
- ki = (i-1)*fn2 + k
- jstart = (i-1)*fn2 + 1
- jend = i*fn2
- D(1:fn1,jstart:jend,k) = C(1:fn1,1:fn2,ki)
- enddo
- enddo
- else
- do k = 1,fn3
- do j = 1,fn2
- do i = 1,fn1
- D(i,j,k) = B(i,j,k)
- enddo
- enddo
- enddo
- endif
-
-end subroutine transpose_backward
-
-
-
-
-
-
-
-
-
-
-subroutine transform_init
-
- use transform
-
-
-
- implicit none
-
- integer :: nsize(2),idim,istride,idist,ostride,odist
- integer :: idim2,istride2,idist2,ostride2,odist2
- integer :: inem(3),onem(3),howmany
- integer, parameter :: NULL = 0
-
- integer :: nsize1
-
-
-! print *,' PLANS', plan_mf1,plan_mf2,plan_mb1,plan_mb2
-
-
-end subroutine transform_init
-
-
-subroutine ftran_wrap(in,out,n1,n2,n3,fn1,fn2,fn3)
-
- use transform
- use precision
- implicit none
-
- integer :: n1,n2,n3,fn1,fn2,fn3
- real(WP) :: in(n1,n2,n3)
- complex(WP) :: out(fn1,fn2,fn3)
- integer :: i,j,k
-
- allocate(A(n1,n2,n3))
- allocate(B(fn1,fn2,fn3))
- allocate(C(fn1,fn2,fn3))
- allocate(D(fn1,fn3,fn2))
-
-
- do k = 1,n3
- do j = 1,n2
- do i = 1,n1
- A(i,j,k) = in(i,j,k)
- enddo
- enddo
- enddo
-
- call forward_transform(n1,n2,n3,fn1,fn2,fn3)
-
- do k = 1,fn3
- do j = 1,fn2
- do i = 1,fn1
- out(i,j,k) = B(i,j,k)
- enddo
- enddo
- enddo
- deallocate(A)
- deallocate(B)
- deallocate(C)
- deallocate(D)
-
-
-end subroutine ftran_wrap
-
-subroutine btran_wrap(in,out,n1,n2,n3,fn1,fn2,fn3)
-
- use transform
- use precision
-
- implicit none
-
- integer :: n1,n2,n3,fn1,fn2,fn3
- real(WP) :: out(n1,n2,n3)
- complex(WP) :: in(fn1,fn2,fn3)
-
-
- integer :: i,j,k
-
-
- allocate(A(n1,n2,n3))
- allocate(B(fn1,fn2,fn3))
- allocate(C(fn1,fn2,fn3))
- allocate(D(fn1,fn3,fn2))
-
-
- do k = 1,fn3
- do j = 1,fn2
- do i = 1,fn1
- B(i,j,k) = in(i,j,k)
- enddo
- enddo
- enddo
-
-
- call backward_transform(n1,n2,n3,fn1,fn2,fn3)
-
- do k = 1,n3
- do j = 1,n2
- do i = 1,n1
- out(i,j,k) = A(i,j,k)
- enddo
- enddo
- enddo
-
- deallocate(A)
- deallocate(B)
- deallocate(C)
- deallocate(D)
-
-
-end subroutine btran_wrap
diff --git a/Code_LEGI/x_advec.f90 b/Code_LEGI/x_advec.f90
deleted file mode 100644
index df52a79574615c786d0670cd5cecd0d2d7503da1..0000000000000000000000000000000000000000
--- a/Code_LEGI/x_advec.f90
+++ /dev/null
@@ -1,531 +0,0 @@
-module x_advec_m
-
- use solver
- use data
-
- implicit none
-
- integer :: npart, ntag_total, npg
- real(WP) :: xmin, ymin, zmin, xmax, ymax, zmax, cfl
- integer, dimension(:), allocatable :: itype
- integer, dimension(:), allocatable :: itype_aux
- integer, dimension(:), allocatable :: itag
- integer, dimension(:), allocatable :: icfl
- real(WP), dimension(:), allocatable :: up
- real(WP), dimension(:), allocatable :: up_aux
- real(WP), dimension(:), allocatable :: xp
- real(WP), dimension(:), allocatable :: xp0
- real(WP), dimension(:), allocatable :: xp_aux
- real(WP), dimension(:), allocatable :: vx
- real(WP), dimension(:), allocatable :: vx_aux
-
- real(WP) :: circlim
-
-end module x_advec_m
-
-
-
-subroutine x_advec_init
-
- use x_advec_m
-
- implicit none
-
- npg = nxsc !100000
-
- allocate(up(npg))
- allocate(up_aux(npg))
- allocate(xp(npg)) !!-> code original npg = 256 mais ca marche pas
- allocate(xp0(npg))
- allocate(xp_aux(npg))
- allocate(vx(npg))
- allocate(vx_aux(npg))
- allocate(itype(npg))
- allocate(itype_aux(npg))
- allocate(itag(npg))
- allocate(icfl(npg))
-
- up = 0.0
- up_aux = 0.0
- xp = 0.0
- xp0 = 0.0
- xp_aux = 0.0
- vx = 0.0
- vx_aux = 0.0
- cfl = 0.0
-
- itype = 0
- itype_aux = 0
- itag = 0
- icfl = 0
-
- npart = 0
-
- xmin = 0.
- ymin = 0.
- zmin = 0.
- xmax = L
- ymax = L
- zmax = L
-
- circlim = -1 !10**(-5)
-
-end subroutine x_advec_init
-
-
-
-subroutine x_advec
-
- use x_advec_m
-
- implicit none
-
- real(WP) :: dx, yy, zz
- integer :: i,j,k,np,n, jr, kr, np_aux, ini, ntag
-
- dx = L/nxsc
- cfl = dt/dx
-
- npart = 0
- ntag_total = 0
- ntag = 0
-
- do k=1,nxsc
- zz=xmin+float(k-1)*dx
- do j=1,nxsc
- np=0
- yy=xmin+float(j-1)*dx
- do i=1,nxsc
- if (abs(SC(i,j,k)).gt.circlim) then
- np=np+1
- up(np)=SC(i,j,k)
- xp(np)=xmin+float(i-1)*dx
- end if
- end do
- if (np.ne.0) then
- call velox_x(np,j,k)
- do n=1,np
- xp0(n)=xp(n)
- xp(n)=xp(n)+0.5*dt*vx(n)
- if (xp(n).gt.xmax) xp(n)=xp(n)-xmax+xmin
- if (xp(n).lt.xmin) xp(n)=xp(n)+xmax-xmin
- end do
- call velox_x(np,j,k)
-
-!! debut modif
-
-
- call tag_particles(np,np_aux,ntag)
- ntag_total = ntag_total + ntag
- ! test
- !itype(1:np_aux) = 1
-
-! np integer: deja defini (input) - local
-! np_aux integer: deja defini (output) - local
-! ntag integer: deja defini (output) - local
-! np_bl=1 --> supprimer de l'appel
-! icfl tablo integer: deja defini - common --> supprimer de l'appel
-! itype tablo integer: deja defini - common --> supprimer de l'appel
-! itype_aux tablo integer: deja defini - common --> supprimer de l'appel
-! itag tablo integer: deja defini - common --> supprimer de l'appel
-! xp_aux tablo real integer: deja defini - common --> supprimer de l'appel
-! up_aux tablo real integer: deja defini - common --> supprimer de l'appel
-! vx_aux tablo real integer: deja defini - common --> supprimer de l'appel
-
-! ---- > trouver les dimension max des tablo
-! ---- > trouver si les tablo doivent etre declarer en local ou en common
-
- if (ntag.ne.0) then
- do n=1,ntag
- ini=itag(n)
- xp(ini)=xp0(ini)+dt*vx(ini)
- if (xp(ini).gt.xmax) xp(ini)=xp(ini)-xmax+xmin
- if (xp(ini).lt.xmin) xp(ini)=xp(ini)+xmax-xmin !! TO CHECK WITH GH
- end do
- end if
-
- do n=1,np_aux
- xp_aux(n)=xp_aux(n)+dt*vx_aux(n)
- if (xp_aux(n).gt.xmax) xp_aux(n)=xp_aux(n)-xmax+xmin
- if (xp_aux(n).lt.xmin) xp_aux(n)=xp_aux(n)+xmax-xmin
- end do
- jr=j
- kr=k
- call remeshx(np_aux,jr,kr)
- if (ntag.ne.0) call remeshx_tag(ntag,jr,kr)
-
-!! fin modif
-
- npart=npart+np
- end if
- end do
- end do
-
- print*, 'NPART, NTAG ', npart,ntag_total
- print*,'ntag x_advec :', ntag_total
-
-
-end subroutine x_advec
-
-
-
-subroutine velox_x(np,j,k)
-
- use x_advec_m
-
- implicit none
-
- integer :: np, j, k, i, nx3, ny3, nz3, jp1, jp2, kp1, kp2, ip1, ip2
- real(WP) :: dx3, dy3, dz3, dxinv, yy, zz, x0, y0, z0, dx2
- real(WP) :: yy1, yy2, zz1, zz2, b1, b2, c1, c2, a1, a2
- real(WP) :: x, xx1, xx2
-
- do i=1,np
- vx(i)=0.
- end do
-
- nx3=nxsc
- ny3=nx3
- nz3=nx3
- dx3=xmax/float(nx3)
- dy3=dx3
- dz3=dx3
-
- dxinv=1./dx3
-
- x0=xmin
- y0=ymin
- z0=zmin
-
- dx2 = L/nxsc
-
- yy=+float(j-1)*dx2
- zz=+float(k-1)*dx2
-
- jp1 = int((yy)/dx3)
- jp2 = jp1 + 1
- kp1 = int((zz)/dx3)
- kp2 = kp1 + 1
- yy1 = (yy-float(jp1)*dx3)/dx3
- yy2 = 1.0 - yy1
- zz1 = (zz-float(kp1)*dx3)/dx3
- zz2 = 1.0 - zz1
- b1=yy2
- b2=yy1
- c1=zz2
- c2=zz1
-
- jp1=mod(jp1+nx3,nx3) +1
- jp2=mod(jp2+nx3,nx3) +1
- kp1=mod(kp1+nx3,nx3) +1
- kp2=mod(kp2+nx3,nx3) +1
-
- do i = 1,np
-
- x = xp(i)
-
- ip1 = int((x-x0)*dxinv)
- ip2 = ip1 + 1
-
- xx1 = (x - float(ip1)*dx3-x0)*dxinv
- xx2=1-xx1
-
- ip1=mod(ip1+nx3,nx3) +1
- ip2=mod(ip2+nx3,nx3) +1
-
- a1 = xx2
- a2 = xx1
-
- vx(i)= vx(i) + Usc(ip1,jp1,kp1)*a1*b1*c1
- vx(i)= vx(i) + Usc(ip2,jp1,kp1)*a2*b1*c1
- vx(i)= vx(i) + Usc(ip1,jp2,kp1)*a1*b2*c1
- vx(i)= vx(i) + Usc(ip2,jp2,kp1)*a2*b2*c1
- vx(i)= vx(i) + Usc(ip1,jp1,kp2)*a1*b1*c2
- vx(i)= vx(i) + Usc(ip2,jp1,kp2)*a2*b1*c2
- vx(i)= vx(i) + Usc(ip1,jp2,kp2)*a1*b2*c2
- vx(i)= vx(i) + Usc(ip2,jp2,kp2)*a2*b2*c2
-
- end do
-
-end subroutine velox_x
-
-subroutine remeshx(np1,jj,kk)
-
- use x_advec_m
-
- implicit none
-
- integer :: np1, jj, kk
- integer :: i, nx2, n, ip0, ip1, ip2, k, j
- real(WP) :: dxinv, dx2, x0, g1, x, xx0, xx1, xx2, a0, a1, a2
-
- nx2 = nxsc
- dx2 = L/nx2
-
- dxinv=1./dx2
-
- do i=1,nx2
- SC(i,jj,kk)=0.
- enddo
-
- x0=xmin
-
- do n = 1,np1
- g1 = up_aux(n)
- x = xp_aux(n)
-
- if (itype_aux(n).eq.0) then
- ip1 = int((x-x0)*dxinv)
- ip0 = ip1 - 1
- ip2 = ip1 + 1
-
- xx1 = (x - float(ip1)*dx2-x0)*dxinv
- xx0=xx1+1
- xx2=1-xx1
-
- ip1=mod(ip1+nx2,nx2) +1
- ip0=mod(ip0+nx2,nx2) +1
- ip2=mod(ip2+nx2,nx2) +1
-
- a0=-0.5*xx1*xx2
- a1=1.-xx1**2
- a2=0.5*xx0*xx1
-
- SC(ip0,jj,kk) = SC(ip0,jj,kk) + g1*a0
- SC(ip1,jj,kk) = SC(ip1,jj,kk) + g1*a1
- SC(ip2,jj,kk) = SC(ip2,jj,kk) + g1*a2
-
- else
-
- ip1 = nint((x-x0)*dxinv)
- ip0 = ip1 - 1
- ip2 = ip1 + 1
-
- xx1 = (x - float(ip1)*dx2-x0)*dxinv
- xx0=xx1+1
- xx2=1-xx1
-
- ip1=mod(ip1+nx2,nx2) +1
- ip0=mod(ip0+nx2,nx2) +1
- ip2=mod(ip2+nx2,nx2) +1
-
- a0=-0.5*xx1*xx2
- a1=1.-xx1**2
- a2=0.5*xx0*xx1
-
- SC(ip0,jj,kk) = SC(ip0,jj,kk) + g1*a0
- SC(ip1,jj,kk) = SC(ip1,jj,kk) + g1*a1
- SC(ip2,jj,kk) = SC(ip2,jj,kk) + g1*a2
-
- end if
- end do
-
-!!! go to 222 !! -> ca veut dire quoi goto ?
-!!! do k=3,nx2-2
-!!! do j=1,nx2
-!!! do i=1,nx2
-!!! if (SC(i,j,k).gt.1.2) then
-!!! print*,'BOUM', i,j,k,SC(i,j,k)
-!!! goto 222
-!!! end if
-!!! end do
-!!! end do
-!!! end do
-
-end subroutine remeshx
-
-subroutine tag_particles(npt,npart_aux,ntag)
-
- use x_advec_m
-
- implicit none
-
- integer :: npt, npart_aux, ntag
-
- integer :: ntype(npg),ncfl(npg),npart_bl(npg),i_nbl(npg)
- real(WP) :: amin_lambda(npg), cflm
-
- real(WP) :: x0, dx, dx_bl, dx_bl_inv
- integer :: nblock, m, nbl, i, j, ini, jj, jc
-
- x0=xmin
-
- cflm = cfl
-
-
- m = 2 !np_bl+1
- nblock=nxsc/(m)
- dx = L/nxsc
- dx_bl=float(m)*dx
- dx_bl_inv=1./dx_bl
-
- do nbl=1,nblock
- amin_lambda(nbl)=111.
- npart_bl(nbl)=0
- i_nbl(nbl)=0
- enddo
-
- do i=1,npt
- nbl=1+int((xp0(i)-x0+0.00001)*dx_bl_inv)
- amin_lambda(nbl)=amin1(amin_lambda(nbl),vx(i)*cflm)
- npart_bl(nbl)=npart_bl(nbl)+1
- i_nbl(nbl)=i
- enddo
-
- do nbl=1,nblock-1
- if (i_nbl(nbl).ne.0) then
- ini=i_nbl(nbl)
- if ((ini.lt.npt).and.(xp0(ini+1).lt.xp0(ini)+1.5*dx)) then
- amin_lambda(nbl)=amin1(amin_lambda(nbl),vx(ini+1)*cflm)
- end if
- end if
- end do
-
- nbl=nblock
- if (i_nbl(nbl).ne.0) then
- if ((xp0(npt).ge.xmax-1.5*dx).and.(xp0(1).lt.xmin+0.5*dx)) then
- amin_lambda(nbl)=amin1(amin_lambda(nbl),vx(1)*cflm)
- end if
- end if
-
- do nbl=1,nblock
- if (amin_lambda(nbl).lt.nint(amin_lambda(nbl))) then
- ntype(nbl)=1
- ncfl(nbl)=nint(amin_lambda(nbl))
- else
- ntype(nbl)=0
- ncfl(nbl)=int(amin_lambda(nbl))
- if (amin_lambda(nbl).lt.0) ncfl(nbl)=int(amin_lambda(nbl))-1
- endif
- end do
-
- do i=1,npt
- nbl=1+int((xp0(i)-x0+0.00001)*dx_bl_inv)
- itype(i)=ntype(nbl)
- icfl(i)=ncfl(nbl)
- end do
-
- ntag=0
- npart_aux=0
- j=2
- jc=0
- do i=2,npt-1
- j=j+jc
- if (j.lt.npt) then
- jj=j+1
- if ((icfl(j).ne.icfl(jj)).and.(itype(j).ne.itype(jj)).and.(xp0(jj).le.xp0(j)+1.5*dx)) then
- ntag=ntag+1
- itag(ntag)=j
- ntag=ntag+1
- itag(ntag)=j+1
- jc=2
- else
- npart_aux=npart_aux+1
- xp_aux(npart_aux)=xp0(j)
- up_aux(npart_aux)=up(j)
- vx_aux(npart_aux)=vx(j)
- itype_aux(npart_aux)=itype(j)
- jc=1
- end if
- end if
- end do
-
- if (npt.ge.1) then
-
- if ((icfl(1).ne.icfl(npt)).and.(itype(1).ne.itype(npt)) &
- & .and.(xp0(npt).ge.xp0(1)+(float(nxsc)-1.5)*dx) &
- & .and.(itag(ntag).ne.npt)) then
- ntag=ntag+1
- itag(ntag)=npt
- ntag=ntag+1
- itag(ntag)=1
- else
- npart_aux=npart_aux+1
- xp_aux(npart_aux)=xp0(1)
- up_aux(npart_aux)=up(1)
- vx_aux(npart_aux)=vx(1)
- itype_aux(npart_aux)=itype(1)
- if (npt.gt.1) then
- npart_aux=npart_aux+1
- xp_aux(npart_aux)=xp0(npt)
- up_aux(npart_aux)=up(npt)
- vx_aux(npart_aux)=vx(npt)
- itype_aux(npart_aux)=itype(npt)
- end if
- end if
- end if
-
-end subroutine tag_particles
-
-subroutine remeshx_tag(ntag,jj,kk)
-
-
- use x_advec_m
-
- implicit none
-
- integer :: ntag, jj, kk
- integer :: i, nx2, n, ip0, ip1, ip2, k, j, ini, jp1, ip3, ip4
- real(WP) :: dxinv, dx2, x0, g1, x, xx0, xx1, xx2, a0, a1, a2, b1, b2, y, u1, u2, yy0, yy1, yy2
-
- nx2 = nxsc
- dx2 = L/nx2
-
- dxinv=1./dx2
- x0=xmin
-
- do n=1,ntag-1,2
- i=itag(n)
- ini=itag(n+1)
- x=xp(i)
- y=xp(ini)
- u1=up(i)
- u2=up(ini)
- if (itype(i).eq.0) then
- ip1 = int((x-x0)*dxinv)
- jp1 = nint((y-x0)*dxinv)
- xx1 = (x - float(ip1)*dx2-x0)*dxinv
- yy1 = (y - float(jp1)*dx2-x0)*dxinv
- xx0=xx1+1
- xx2=1-xx1
- yy0=yy1+1
- yy2=1-yy1
- ip0=ip1-1
- ip2=ip1+1
- ip3=ip1+2
- ip4=ip1+3
- ip1=mod(ip1+nx2,nx2) +1
- ip0=mod(ip0+nx2,nx2) +1
- ip2=mod(ip2+nx2,nx2) +1
- ip3=mod(ip3+nx2,nx2) +1
- ip4=mod(ip4+nx2,nx2) +1
- a0=-xx1*xx2/2.
- a1=xx0*xx2
- b1=yy0*yy2
- b2=yy0*yy1/2.
- SC(ip0,jj,kk)=SC(ip0,jj,kk)+a0*u1
- SC(ip1,jj,kk)=SC(ip1,jj,kk)+a1*u1+(1.+yy1-b1-b2)*u2
- SC(ip2,jj,kk)=SC(ip2,jj,kk)+xx1*u1-yy1*u2
- SC(ip3,jj,kk)=SC(ip3,jj,kk)+(1.-a0-a1-xx1)*u1+b1*u2
- SC(ip4,jj,kk)=SC(ip4,jj,kk)+b2*u2
- else
- ip1 = nint((x-x0)*dxinv)
- jp1 = int((y-x0)*dxinv)
- xx1 = (x - float(ip1)*dx2-x0)*dxinv
- yy1 = (y - float(jp1)*dx2-x0)*dxinv
- xx2=1-xx1
- yy0=yy1+1
- ip0=ip1-1
- ip2=ip1+1
- ip1=mod(ip1+nx2,nx2) +1
- ip0=mod(ip0+nx2,nx2) +1
- ip2=mod(ip2+nx2,nx2) +1
- a0=-0.5*xx1*xx2
- b2=0.5*yy0*yy1
- SC(ip0,jj,kk)=SC(ip0,jj,kk)+a0*u1
- SC(ip1,jj,kk)=SC(ip1,jj,kk)+(1.-a0)*u1+(1.-b2)*u2
- SC(ip2,jj,kk)=SC(ip2,jj,kk)+b2*u2
- endif
- enddo
-
-end subroutine remeshx_tag
diff --git a/Code_LEGI/y_advec.f90 b/Code_LEGI/y_advec.f90
deleted file mode 100644
index f6dca086bbb934bd09d03e011e8e584aa2caaf92..0000000000000000000000000000000000000000
--- a/Code_LEGI/y_advec.f90
+++ /dev/null
@@ -1,330 +0,0 @@
-subroutine y_advec
-
- use x_advec_m
-
- implicit none
-
- real(WP) :: dx, yy, zz
- integer :: i,j,k,np,n, ir, kr, ini, np_aux, ntag
-
-
- ntag = 0
- ntag_total = 0
- np_aux = 0
-
- dx = L/nxsc
- cfl = dt/dx
-
- do k=1,nxsc
- zz=xmin+float(k-1)*dx
- do i=1,nxsc
- np=0
- yy=xmin+float(i-1)*dx
- do j=1,nxsc
- if (abs(SC(i,j,k)).gt.circlim) then
- np=np+1
- up(np)=SC(i,j,k)
- xp(np)=xmin+float(j-1)*dx
- endif
- enddo
- if (np.ne.0) then
- call velox_y(np,i,k)
- do n=1,np
- xp0(n)=xp(n)
- xp(n)=xp(n)+0.5*dt*vx(n)
- if (xp(n).gt.xmax) xp(n)=xp(n)-xmax+xmin
- if (xp(n).lt.xmin) xp(n)=xp(n)+xmax-xmin
- enddo
- call velox_y(np,i,k)
-
-!! debut modif
-
- call tag_particles(np,np_aux,ntag)
- ntag_total = ntag_total + ntag
- ! test
- !itype(1:np_aux) = 1
-
-! np integer: deja defini (input) - local
-! np_aux integer: deja defini (output) - local
-! ntag integer: deja defini (output) - local
-! np_bl=1 --> supprimer de l'appel
-! icfl tablo integer: deja defini - common --> supprimer de l'appel
-! itype tablo integer: deja defini - common --> supprimer de l'appel
-! itype_aux tablo integer: deja defini - common --> supprimer de l'appel
-! itag tablo integer: deja defini - common --> supprimer de l'appel
-! xp_aux tablo real integer: deja defini - common --> supprimer de l'appel
-! up_aux tablo real integer: deja defini - common --> supprimer de l'appel
-! vx_aux tablo real integer: deja defini - common --> supprimer de l'appel
-
-! ---- > trouver les dimension max des tablo
-! ---- > trouver si les tablo doivent etre declarer en local ou en common
-
- if (ntag.ne.0) then
- do n=1,ntag
- ini=itag(n)
- xp(ini)=xp0(ini)+dt*vx(ini)
- if (xp(ini).gt.xmax) xp(ini)=xp(ini)-xmax+xmin
- if (xp(ini).lt.xmin) xp(ini)=xp(ini)+xmax-xmin !! TO CHECK WITH GH
- end do
- end if
-
- do n=1,np_aux
- xp_aux(n)=xp_aux(n)+dt*vx_aux(n)
- if (xp_aux(n).gt.xmax) xp_aux(n)=xp_aux(n)-xmax+xmin
- if (xp_aux(n).lt.xmin) xp_aux(n)=xp_aux(n)+xmax-xmin
- end do
- ir=i
- kr=k
- call remeshy(np_aux,ir,kr)
- if (ntag.ne.0) call remeshy_tag(ntag,ir,kr)
-
-!! fin modif
-
- endif
- enddo
- enddo
-
- print*,'ntag y_advec :', ntag_total
-
-
-end subroutine y_advec
-
-
-
-subroutine velox_y(np,j,k)
-
- use x_advec_m
-
- implicit none
-
- integer :: np, j, k, i, nx3, ny3, nz3, jp1, jp2, kp1, kp2, ip1, ip2
- real(WP) :: dx3, dy3, dz3, dxinv, yy, zz, x0, y0, z0, dx2
- real(WP) :: yy1, yy2, zz1, zz2, b1, b2, c1, c2, a1, a2
- real(WP) :: x, xx1, xx2
-
- do i=1,np
- vx(i)=0.
- end do
-
- nx3=nxsc
- ny3=nx3
- nz3=nx3
- dx3=xmax/float(nx3)
- dy3=dx3
- dz3=dx3
-
- dxinv=1./dx3
-
- x0=xmin
- y0=ymin
- z0=zmin
-
- dx2 = L/nxsc
-
- yy=+float(j-1)*dx2
- zz=+float(k-1)*dx2
-
- jp1 = int((yy)/dx3)
- jp2 = jp1 + 1
- kp1 = int((zz)/dx3)
- kp2 = kp1 + 1
- yy1 = (yy-float(jp1)*dx3)/dx3
- yy2 = 1.0 - yy1
- zz1 = (zz-float(kp1)*dx3)/dx3
- zz2 = 1.0 - zz1
- b1=yy2
- b2=yy1
- c1=zz2
- c2=zz1
-
- jp1=mod(jp1+nx3,nx3) +1
- jp2=mod(jp2+nx3,nx3) +1
- kp1=mod(kp1+nx3,nx3) +1
- kp2=mod(kp2+nx3,nx3) +1
-
- do i = 1,np
-
- x = xp(i)
-
- ip1 = int((x-x0)*dxinv)
- ip2 = ip1 + 1
-
- xx1 = (x - float(ip1)*dx3-x0)*dxinv
- xx2=1-xx1
-
- ip1=mod(ip1+nx3,nx3) +1
- ip2=mod(ip2+nx3,nx3) +1
-
- a1 = xx2
- a2 = xx1
-
- vx(i)= vx(i) + Vsc(jp1,ip1,kp1)*a1*b1*c1
- vx(i)= vx(i) + Vsc(jp1,ip2,kp1)*a2*b1*c1
- vx(i)= vx(i) + Vsc(jp2,ip1,kp1)*a1*b2*c1
- vx(i)= vx(i) + Vsc(jp2,ip2,kp1)*a2*b2*c1
- vx(i)= vx(i) + Vsc(jp1,ip1,kp2)*a1*b1*c2
- vx(i)= vx(i) + Vsc(jp1,ip2,kp2)*a2*b1*c2
- vx(i)= vx(i) + Vsc(jp2,ip1,kp2)*a1*b2*c2
- vx(i)= vx(i) + Vsc(jp2,ip2,kp2)*a2*b2*c2
-
- end do
-
-end subroutine velox_y
-
-subroutine remeshy(np1,jj,kk)
-
- use x_advec_m
-
- implicit none
-
- integer :: np1, jj, kk
- integer :: i, nx2, n, ip0, ip1, ip2, k, j
- real(WP) :: dxinv, dx2, x0, g1, x, xx0, xx1, xx2, a0, a1, a2
-
- nx2 = nxsc
- dx2 = L/nx2
-
- dxinv=1./dx2
-
- do i=1,nx2
- SC(jj,i,kk)=0.
- enddo
-
- x0=xmin
-
- do n = 1,np1
- g1 = up_aux(n)
- x = xp_aux(n)
-
- if (itype_aux(n).eq.0) then
- ip1 = int((x-x0)*dxinv)
- ip0 = ip1 - 1
- ip2 = ip1 + 1
-
- xx1 = (x - float(ip1)*dx2-x0)*dxinv
- xx0=xx1+1
- xx2=1-xx1
-
- ip1=mod(ip1+nx2,nx2) +1
- ip0=mod(ip0+nx2,nx2) +1
- ip2=mod(ip2+nx2,nx2) +1
-
- a0=-0.5*xx1*xx2
- a1=1.-xx1**2
- a2=0.5*xx0*xx1
-
- SC(jj,ip0,kk) = SC(jj,ip0,kk) + g1*a0
- SC(jj,ip1,kk) = SC(jj,ip1,kk) + g1*a1
- SC(jj,ip2,kk) = SC(jj,ip2,kk) + g1*a2
-
- else
-
- ip1 = nint((x-x0)*dxinv)
- ip0 = ip1 - 1
- ip2 = ip1 + 1
-
- xx1 = (x - float(ip1)*dx2-x0)*dxinv
- xx0=xx1+1
- xx2=1-xx1
-
- ip1=mod(ip1+nx2,nx2) +1
- ip0=mod(ip0+nx2,nx2) +1
- ip2=mod(ip2+nx2,nx2) +1
-
- a0=-0.5*xx1*xx2
- a1=1.-xx1**2
- a2=0.5*xx0*xx1
-
- SC(jj,ip0,kk) = SC(jj,ip0,kk) + g1*a0
- SC(jj,ip1,kk) = SC(jj,ip1,kk) + g1*a1
- SC(jj,ip2,kk) = SC(jj,ip2,kk) + g1*a2
-
- end if
- end do
-
-!!! go to 222 !! -> ca veut dire quoi goto ?
-!!! do k=3,nx2-2
-!!! do j=1,nx2
-!!! do i=1,nx2
-!!! if (SC(i,j,k).gt.1.2) then
-!!! print*,'BOUM', i,j,k,SC(i,j,k)
-!!! goto 222
-!!! end if
-!!! end do
-!!! end do
-!!! end do
-
-end subroutine remeshy
-
-subroutine remeshy_tag(ntag,jj,kk)
-
-
- use x_advec_m
-
- implicit none
-
- integer :: jj, kk, ntag
- integer :: i, nx2, n, ip0, ip1, ip2, k, j, ini, jp1, ip3, ip4
- real(WP) :: dxinv, dx2, x0, g1, x, xx0, xx1, xx2, a0, a1, a2, u1, u2, y, yy1, yy0, yy2, b1, b2
-
- nx2 = nxsc
- dx2 = L/nx2
-
- dxinv=1./dx2
- x0=xmin
-
- do n=1,ntag,2
- i=itag(n)
- ini=itag(n+1)
- x=xp(i)
- y=xp(ini)
- u1=up(i)
- u2=up(ini)
- if (itype(i).eq.0) then
- ip1 = int((x-x0)*dxinv)
- jp1 = nint((y-x0)*dxinv)
- xx1 = (x - float(ip1)*dx2-x0)*dxinv
- yy1 = (y - float(jp1)*dx2-x0)*dxinv
- xx0=xx1+1
- xx2=1-xx1
- yy0=yy1+1
- yy2=1-yy1
- ip0=ip1-1
- ip2=ip1+1
- ip3=ip1+2
- ip4=ip1+3
- ip1=mod(ip1+nx2,nx2) +1
- ip0=mod(ip0+nx2,nx2) +1
- ip2=mod(ip2+nx2,nx2) +1
- ip3=mod(ip3+nx2,nx2) +1
- ip4=mod(ip4+nx2,nx2) +1
- a0=-xx1*xx2/2.
- a1=xx0*xx2
- b1=yy0*yy2
- b2=yy0*yy1/2.
- SC(jj,ip0,kk)=SC(jj,ip0,kk)+a0*u1
- SC(jj,ip1,kk)=SC(jj,ip1,kk)+a1*u1+(1.+yy1-b1-b2)*u2
- SC(jj,ip2,kk)=SC(jj,ip2,kk)+xx1*u1-yy1*u2
- SC(jj,ip3,kk)=SC(jj,ip3,kk)+(1.-a0-a1-xx1)*u1+b1*u2
- SC(jj,ip4,kk)=SC(jj,ip4,kk)+b2*u2
- else
- ip1 = nint((x-x0)*dxinv)
- jp1 = int((y-x0)*dxinv)
- xx1 = (x - float(ip1)*dx2-x0)*dxinv
- yy1 = (y - float(jp1)*dx2-x0)*dxinv
- xx2=1-xx1
- yy0=yy1+1
- ip0=ip1-1
- ip2=ip1+1
- ip1=mod(ip1+nx2,nx2) +1
- ip0=mod(ip0+nx2,nx2) +1
- ip2=mod(ip2+nx2,nx2) +1
- a0=-0.5*xx1*xx2
- b2=0.5*yy0*yy1
- SC(jj,ip0,kk)=SC(jj,ip0,kk)+a0*u1
- SC(jj,ip1,kk)=SC(jj,ip1,kk)+(1.-a0)*u1+(1.-b2)*u2
- SC(jj,ip2,kk)=SC(jj,ip2,kk)+b2*u2
- endif
- enddo
-
-end subroutine remeshy_tag
diff --git a/Code_LEGI/z_advec.f90 b/Code_LEGI/z_advec.f90
deleted file mode 100644
index 5357b686de530849a32a25cd0ce91dfd6b5e2c9c..0000000000000000000000000000000000000000
--- a/Code_LEGI/z_advec.f90
+++ /dev/null
@@ -1,329 +0,0 @@
-subroutine z_advec
-
- use x_advec_m
-
- implicit none
-
- real(WP) :: dx, yy, zz
- integer :: i,j,k,np,n, ir, jr, ini, ntag, np_aux
-
-
- dx = L/nxsc
- cfl = dt/dx
-
- ntag = 0
- ntag_total = 0
- np_aux = 0
-
- do j=1,nxsc
- zz=xmin+float(k-1)*dx
- do i=1,nxsc
- np=0
- yy=xmin+float(i-1)*dx
- do k=1,nxsc
- if (abs(SC(i,j,k)).gt.circlim) then
- np=np+1
- up(np)=SC(i,j,k)
- xp(np)=xmin+float(k-1)*dx
- endif
- enddo
- if (np.ne.0) then
- call velox_z(np,i,j)
- do n=1,np
- xp0(n)=xp(n)
- xp(n)=xp(n)+0.5*dt*vx(n)
- if (xp(n).gt.xmax) xp(n)=xp(n)-xmax+xmin
- if (xp(n).lt.xmin) xp(n)=xp(n)+xmax-xmin
- enddo
- call velox_z(np,i,j)
-
-!! debut modif
-
- call tag_particles(np,np_aux,ntag)
- ntag_total = ntag_total + ntag
- ! test
- !itype(1:np_aux) = 1
-
-! np integer: deja defini (input) - local
-! np_aux integer: deja defini (output) - local
-! ntag integer: deja defini (output) - local
-! np_bl=1 --> supprimer de l'appel
-! icfl tablo integer: deja defini - common --> supprimer de l'appel
-! itype tablo integer: deja defini - common --> supprimer de l'appel
-! itype_aux tablo integer: deja defini - common --> supprimer de l'appel
-! itag tablo integer: deja defini - common --> supprimer de l'appel
-! xp_aux tablo real integer: deja defini - common --> supprimer de l'appel
-! up_aux tablo real integer: deja defini - common --> supprimer de l'appel
-! vx_aux tablo real integer: deja defini - common --> supprimer de l'appel
-
-! ---- > trouver les dimension max des tablo
-! ---- > trouver si les tablo doivent etre declarer en local ou en common
-
- if (ntag.ne.0) then
- do n=1,ntag
- ini=itag(n)
- xp(ini)=xp0(ini)+dt*vx(ini)
- if (xp(ini).gt.xmax) xp(ini)=xp(ini)-xmax+xmin
- if (xp(ini).lt.xmin) xp(ini)=xp(ini)+xmax-xmin !! TO CHECK WITH GH
- end do
- end if
-
- do n=1,np_aux
- xp_aux(n)=xp_aux(n)+dt*vx_aux(n)
- if (xp_aux(n).gt.xmax) xp_aux(n)=xp_aux(n)-xmax+xmin
- if (xp_aux(n).lt.xmin) xp_aux(n)=xp_aux(n)+xmax-xmin
- end do
- ir=i
- jr=j
- call remeshz(np_aux,ir,jr)
- if (ntag.ne.0) call remeshz_tag(ntag,ir,jr)
-
-!! fin modif
-
- endif
- enddo
- enddo
-
- print*,'ntag z_advec :', ntag_total
-
-end subroutine z_advec
-
-
-
-subroutine velox_z(np,j,k)
-
- use x_advec_m
-
- implicit none
-
- integer :: np, j, k, i, nx3, ny3, nz3, jp1, jp2, kp1, kp2, ip1, ip2
- real(WP) :: dx3, dy3, dz3, dxinv, yy, zz, x0, y0, z0, dx2
- real(WP) :: yy1, yy2, zz1, zz2, b1, b2, c1, c2, a1, a2
- real(WP) :: x, xx1, xx2
-
- do i=1,np
- vx(i)=0.
- end do
-
- nx3=nxsc
- ny3=nx3
- nz3=nx3
- dx3=xmax/float(nx3)
- dy3=dx3
- dz3=dx3
-
- dxinv=1./dx3
-
- x0=xmin
- y0=ymin
- z0=zmin
-
- dx2 = L/nxsc
-
- yy=+float(j-1)*dx2
- zz=+float(k-1)*dx2
-
- jp1 = int((yy)/dx3)
- jp2 = jp1 + 1
- kp1 = int((zz)/dx3)
- kp2 = kp1 + 1
- yy1 = (yy-float(jp1)*dx3)/dx3
- yy2 = 1.0 - yy1
- zz1 = (zz-float(kp1)*dx3)/dx3
- zz2 = 1.0 - zz1
- b1=yy2
- b2=yy1
- c1=zz2
- c2=zz1
-
- jp1=mod(jp1+nx3,nx3) +1
- jp2=mod(jp2+nx3,nx3) +1
- kp1=mod(kp1+nx3,nx3) +1
- kp2=mod(kp2+nx3,nx3) +1
-
- do i = 1,np
-
- x = xp(i)
-
- ip1 = int((x-x0)*dxinv)
- ip2 = ip1 + 1
-
- xx1 = (x - float(ip1)*dx3-x0)*dxinv
- xx2=1-xx1
-
- ip1=mod(ip1+nx3,nx3) +1
- ip2=mod(ip2+nx3,nx3) +1
-
- a1 = xx2
- a2 = xx1
-
- vx(i)= vx(i) + Wsc(jp1,kp1,ip1)*a1*b1*c1
- vx(i)= vx(i) + Wsc(jp1,kp1,ip2)*a2*b1*c1
- vx(i)= vx(i) + Wsc(jp2,kp1,ip1)*a1*b2*c1
- vx(i)= vx(i) + Wsc(jp2,kp1,ip2)*a2*b2*c1
- vx(i)= vx(i) + Wsc(jp1,kp2,ip1)*a1*b1*c2
- vx(i)= vx(i) + Wsc(jp1,kp2,ip2)*a2*b1*c2
- vx(i)= vx(i) + Wsc(jp2,kp2,ip1)*a1*b2*c2
- vx(i)= vx(i) + Wsc(jp2,kp2,ip2)*a2*b2*c2
-
- end do
-
-end subroutine velox_z
-
-subroutine remeshz(np1,jj,kk)
-
- use x_advec_m
-
- implicit none
-
- integer :: np1, jj, kk
- integer :: i, nx2, n, ip0, ip1, ip2, k, j
- real(WP) :: dxinv, dx2, x0, g1, x, xx0, xx1, xx2, a0, a1, a2
-
- nx2 = nxsc
- dx2 = L/nx2
-
- dxinv=1./dx2
-
- do i=1,nx2
- SC(jj,kk,i)=0.
- enddo
-
- x0=xmin
-
- do n = 1,np1
- g1 = up_aux(n)
- x = xp_aux(n)
-
- if (itype_aux(n).eq.0) then
- ip1 = int((x-x0)*dxinv)
- ip0 = ip1 - 1
- ip2 = ip1 + 1
-
- xx1 = (x - float(ip1)*dx2-x0)*dxinv
- xx0=xx1+1
- xx2=1-xx1
-
- ip1=mod(ip1+nx2,nx2) +1
- ip0=mod(ip0+nx2,nx2) +1
- ip2=mod(ip2+nx2,nx2) +1
-
- a0=-0.5*xx1*xx2
- a1=1.-xx1**2
- a2=0.5*xx0*xx1
-
- SC(jj,kk,ip0) = SC(jj,kk,ip0) + g1*a0
- SC(jj,kk,ip1) = SC(jj,kk,ip1) + g1*a1
- SC(jj,kk,ip2) = SC(jj,kk,ip2) + g1*a2
-
- else
-
- ip1 = nint((x-x0)*dxinv)
- ip0 = ip1 - 1
- ip2 = ip1 + 1
-
- xx1 = (x - float(ip1)*dx2-x0)*dxinv
- xx0=xx1+1
- xx2=1-xx1
-
- ip1=mod(ip1+nx2,nx2) +1
- ip0=mod(ip0+nx2,nx2) +1
- ip2=mod(ip2+nx2,nx2) +1
-
- a0=-0.5*xx1*xx2
- a1=1.-xx1**2
- a2=0.5*xx0*xx1
-
- SC(jj,kk,ip0) = SC(jj,kk,ip0) + g1*a0
- SC(jj,kk,ip1) = SC(jj,kk,ip1) + g1*a1
- SC(jj,kk,ip2) = SC(jj,kk,ip2) + g1*a2
-
- end if
- end do
-
-!!! go to 222 !! -> ca veut dire quoi goto ?
-!!! do k=3,nx2-2
-!!! do j=1,nx2
-!!! do i=1,nx2
-!!! if (SC(i,j,k).gt.1.2) then
-!!! print*,'BOUM', i,j,k,SC(i,j,k)
-!!! goto 222
-!!! end if
-!!! end do
-!!! end do
-!!! end do
-
-end subroutine remeshz
-
-subroutine remeshz_tag(ntag,kk,jj)
-
-
- use x_advec_m
-
- implicit none
-
- integer :: ntag, jj, kk
- integer :: i, nx2, n, ip0, ip1, ip2, k, j, ini, jp1, ip3, ip4
- real(WP) :: dxinv, dx2, x0, g1, x, xx0, xx1, xx2, a0, a1, a2, b1, b2, y, u1, u2, yy0, yy1, yy2
-
- nx2 = nxsc
- dx2 = L/nx2
-
- dxinv=1./dx2
- x0=xmin
-
- do n=1,ntag,2
- i=itag(n)
- ini=itag(n+1)
- x=xp(i)
- y=xp(ini)
- u1=up(i)
- u2=up(ini)
- if (itype(i).eq.0) then
- ip1 = int((x-x0)*dxinv)
- jp1 = nint((y-x0)*dxinv)
- xx1 = (x - float(ip1)*dx2-x0)*dxinv
- yy1 = (y - float(jp1)*dx2-x0)*dxinv
- xx0=xx1+1
- xx2=1-xx1
- yy0=yy1+1
- yy2=1-yy1
- ip0=ip1-1
- ip2=ip1+1
- ip3=ip1+2
- ip4=ip1+3
- ip1=mod(ip1+nx2,nx2) +1
- ip0=mod(ip0+nx2,nx2) +1
- ip2=mod(ip2+nx2,nx2) +1
- ip3=mod(ip3+nx2,nx2) +1
- ip4=mod(ip4+nx2,nx2) +1
- a0=-xx1*xx2/2.
- a1=xx0*xx2
- b1=yy0*yy2
- b2=yy0*yy1/2.
- SC(kk,jj,ip0)=SC(kk,jj,ip0)+a0*u1
- SC(kk,jj,ip1)=SC(kk,jj,ip1)+a1*u1+(1.+yy1-b1-b2)*u2
- SC(kk,jj,ip2)=SC(kk,jj,ip2)+xx1*u1-yy1*u2
- SC(kk,jj,ip3)=SC(kk,jj,ip3)+(1.-a0-a1-xx1)*u1+b1*u2
- SC(kk,jj,ip4)=SC(kk,jj,ip4)+b2*u2
- else
- ip1 = nint((x-x0)*dxinv)
- jp1 = int((y-x0)*dxinv)
- xx1 = (x - float(ip1)*dx2-x0)*dxinv
- yy1 = (y - float(jp1)*dx2-x0)*dxinv
- xx2=1-xx1
- yy0=yy1+1
- ip0=ip1-1
- ip2=ip1+1
- ip1=mod(ip1+nx2,nx2) +1
- ip0=mod(ip0+nx2,nx2) +1
- ip2=mod(ip2+nx2,nx2) +1
- a0=-0.5*xx1*xx2
- b2=0.5*yy0*yy1
- SC(kk,jj,ip0)=SC(kk,jj,ip0)+a0*u1
- SC(kk,jj,ip1)=SC(kk,jj,ip1)+(1.-a0)*u1+(1.-b2)*u2
- SC(kk,jj,ip2)=SC(kk,jj,ip2)+b2*u2
- endif
- enddo
-
-end subroutine remeshz_tag