subroutine GenerateProblem use basicmod use eosmod use mpimod use boundarymod implicit none integer::i,j,k real(8):: pi real(8):: den, B0, rho1, rho2, dv, wid, sig integer,dimension(2) :: seed real(8),dimension(1) :: rnum real(8),parameter :: rrv =0.0d-2 pi = dacos(-1.0d0) rho1 = 1.0d0 rho2 = 1.0d0 dv = 2.00d0 wid = 0.05d0 sig = 0.2d0 B0 = dsqrt(2.0d0/3.0d0)*0.0d0 do k=ks-mgn,ke+mgn do j=js-mgn,je+mgn do i=is-mgn,ie+mgn d(i,j,k) = 1.0d0 p(i,j,k) = 1.0d0 v1(i,j,k) = 0.5d0 * dv *( dtanh( (x2b(j)+0.5d0)/wid ) - dtanh( (x2b(j) - 0.5d0)/wid ) - 1.0d0 ) v2(i,j,k) = 0.01d0 * sin(2.0d0*pi*x1b(i))* & & ( dexp( - (x2b(j) + 0.5d0)**2/sig**2 ) + & & dexp( - (x2b(j) - 0.5d0)**2/sig**2 ) ) v3(i,j,k) = 0.0d0 b1(i,j,k) = B0 b2(i,j,k) = 0.0d0 b3(i,j,k) = 0.0d0 bp(i,j,k) = 0.0d0 Xcomp(1,i,j,k) = 0.5d0*( dtanh( (x2b(j)+0.5d0)/wid ) - tanh( (x2b(j)-0.5d0)/wid) ) enddo enddo enddo do k=ks-mgn,ke+mgn do j=js-mgn,je+mgn do i=is-mgn,ie+mgn gp(i,j,k) = 0.0d0 enddo enddo enddo if(myid_w == 0) write(6,*) rrv*100.0d0 & & , "% of Randam Perturbation imposed on velocity" seed(1) = 1 seed(2) = 1 + myid_w*in*jn*kn call random_seed(PUT=seed(1:2)) ! pert do k=ks,ke do j=js,je call random_number(rnum) do i=is,ie v1(i,j,k)= v1(i,j,k) + dv*rrv*(rnum(1)-0.5d0) enddo enddo enddo do k=ks,ke do j=js,je do i=is,ie ! adiabatic ei(i,j,k) = p(i,j,k)/(gam-1.0d0) cs(i,j,k) = sqrt(gam*p(i,j,k)/d(i,j,k)) ! isotermal ! ei(i,j,k) = p(i,j,k) ! cs(i,j,k) = csiso enddo enddo enddo !$omp target update to(d,v1,v2,v3) !$omp target update to(p,ei,cs) !$omp target update to(b1,b2,b3,bp) !$omp target update to(gp) !$omp target update to(Xcomp) if(myid_w ==0 ) print *,"initial profile is set" return end subroutine GenerateProblem