!---------------------------------------------- ! MPI_toPMss.f90 ! read MPI files and write PMss format ! (nx,ny,nz) - number of boxes in each direction !---------------------------------------------- Module SetArrs Integer, PARAMETER :: & NROW = 8192, & NGRID = 256, & nx = 3, & ! number of output regions in X ny = 3, & nz = 3, & Nfiles = nx*ny*nz, & ! number of files to write to NPAGE = min(NROW**2,1024**2), & ! # particles in a record nspecies = 1, & n_divx = 3, & ! number of input nodes in x -direction n_divy = 3, & ! number of nodes in y n_divz = 3, & ! number of nodes in z n_nodes = n_divx*n_divy*n_divz ! number of files to read from Real*4, PARAMETER :: Rhalo=2.5 ! width of buffer for output Real*4, Allocatable,Dimension(:,:) :: Xp,Yp,Zp,VXp,VYp,Vzp,Wpar, & Xbp,Ybp,Zbp,VXbp,VYbp,Vzbp,Wbpar Integer*8, Allocatable,Dimension(:,:) :: IDs,IDb Real :: Box,extras(100),memory Integer*8 :: lspecies(10) Real*4 :: wspecies(nspecies) Integer*8 :: jCount(Nfiles),iCount(Nfiles) INTEGER*4 :: np_sb(n_nodes) ! number of p. per node INTEGER*4 :: l_divX( n_divx +1) ! X coordinates of node INTEGER*4 :: l_divY( n_divx,n_divy +1) ! Y coordinates of node INTEGER*4 :: l_divZ(n_divx ,n_divy ,n_divz +1) ! Z coord Integer*4 :: Np_max,N_omp,moment, & ISTEP,Nspecs,Nseed,NROWC,NGRIDC Integer*8 :: Nnx(nx),Nny(ny),Nnz(nz) ! sum of particles in each bin Real*4 :: BoundX(nx+1),BoundY(ny+1),BoundZ(nz+1) ! boundaries of nodes character*45 HEADER Real*4 :: AEXPN,AEXP0,AMPLT,ASTEP,PARTW, & TINTG,EKIN,EKIN1,EKIN2,AU0,AEU0, & Om0,Oml0,hubble,Wp5,Ocurv EQUIVALENCE (wspecies(1),extras(1)), & (lspecies(1),extras(11)) Contains !-------------------------------------------------------------- ! Set Boundaries of nodes SUBROUTINE Set_Boundaries !-------------------------------------------------------------- !k0 = (i_node-1)/(nx*ny)+1 ! 3d coordinated of the region !j0 = (i_node-(k0-1)*nx*ny-1)/nx+1 !i0 = i_node-(k0-1)*nx*ny-(j0-1)*nx dx = float(NGRID)/float(nx) ! size of the region dy = float(NGRID)/float(ny) dz = float(NGRID)/float(nz) ! define boundaries of regions BoundX(nx+1) = NGRID+1. BoundY(ny+1) = NGRID+1. BoundZ(nz+1) = NGRID+1. Do i=1,nx BoundX(i) = dx*(i-1)+1. EndDo Do i=1,ny BoundY(i) = dy*(i-1)+1. EndDo Do i=1,nz BoundZ(i) = dz*(i-1)+1. EndDo !BoundX(2) = 93.; BoundX(3) = 117.; BoundX(4) = 135.; BoundX(5) = 173.;BoundX(6) = 187. !BoundY(2) = 50.; BoundY(3) = 78. ; BoundY(4) = 105.; BoundY(5) = 145.;BoundY(6) = 190. !BoundZ(2) = 40.; BoundZ(3) = 100.; BoundZ(4) = 136.; BoundZ(5) = 168.;BoundZ(6) = 180. end SUBROUTINE Set_Boundaries !-------------------------------------------------------------- ! write particles for this region SUBROUTINE Region_write(i_case,i_node,myOMP) !-------------------------------------------------------------- Real*8 :: xmin,xmax,ymin,ymax,zmin,zmax Integer*4 :: i_over,imap(-1:1),j_over,jmap(-1:1),k_over,kmap(-1:1) character*120 :: fNames k0 = (i_node-1)/(nx*ny)+1 ! 3d coordinated of the region j0 = (i_node-(k0-1)*nx*ny-1)/nx+1 i0 = i_node-(k0-1)*nx*ny-(j0-1)*nx ! define boundaries of regions !xL = BoundX(i0)-Rhalo ; xR = BoundX(i0+1) +Rhalo !yL = BoundY(j0)-Rhalo ; yR = BoundY(j0+1) +Rhalo !zL = BoundZ(k0)-Rhalo ; zR = BoundZ(k0+1) +Rhalo xL = l_divX(i0) -Rhalo ; xR = l_divX(i0+1) +Rhalo yL = l_divY(i0,j0) -Rhalo ; yR = l_divY(i0,j0+1) +Rhalo zL = l_divZ(i0,j0,k0)-Rhalo ; zR = l_divZ(i0,j0,k0+1) +Rhalo iCount(i_node) = 0 ! initiate counters jCount(i_node) = 0 ! open files, write headers write(fNames,'(a,i4.4,a,i4.4,a)') 'PMss/PMss.',i_node,'.',ISTEP,'.DAT' open(200+i_node,file=fNames,form='unformatted') write(200+i_node)HEADER write(200+i_node)AEXPN,ASTEP,ISTEP,NROWC,NGRIDC,Nspecies, & Nseed,Om0,Oml0,hubble,Box write(200+i_node) i_node,Nx,Ny,Nz,Rhalo write(200+i_node) xL,xR,yL,yR,zL,zR ! write(200+i_node,*)HEADER ! write(200+i_node,100)AEXPN,ASTEP,ISTEP,NROWC,NGRIDC,Nspecies, & ! Nseed,Om0,Oml0,hubble,Box ! write(200+i_node,'(4i5)') k,Nx,Ny,Nz ! write(200+i_node,'(6f8.3)') xL,xR,yL,yR,zL,zR 100 format(f9.4,f9.5,i6,2i6,i4,i10,4f8.3) Do ib =1,n_divx ! loop through all MPI nodes Do jb =1,n_divy Do kb =1,n_divz zbL = l_divZ(ib ,jb ,kb) ; zbR = l_divZ(ib ,jb ,kb+1) ybL = l_divY(ib ,jb ) ; ybR = l_divY(ib ,jb+1) xbL = l_divX(ib ) ; xbR = l_divX(ib+1) Call Overlap(xL,xR,xbL,xbR,i_over,imap) Call Overlap(yL,yR,ybL,ybR,j_over,jmap) Call Overlap(zL,zR,zbL,zbR,k_over,kmap) If(i_over*j_over*k_over.ne.0)Then ! there is overlap m_node =ib+(jb-1)*n_divx+(kb-1)*n_divx*n_divy CALL Read_MPI (i_case,m_node,myOMP) Np = np_sb(m_node) Do i=-1,1 If(imap(i)/=0)Then Do j=-1,1 If(jmap(j)/=0)Then Do k=-1,1 If(kmap(k)/=0)Then CALL Update_Region(xL,xR,yL,yR,zL,zR,Np,i,j,k,i_node,myOMP) EndIf End Do End If End Do End If End Do EndIf End Do End Do End Do If(iCount(i_node)/=0)Then ! write end of buffer Nrecord = iCount(i_node) write(200+i_node)Nrecord write(200+i_node)(Xbp(jj,myOMP),jj=1,Nrecord) write(200+i_node)(Ybp(jj,myOMP),jj=1,Nrecord) write(200+i_node)(Zbp(jj,myOMP),jj=1,Nrecord) write(200+i_node)(VXbp(jj,myOMP),jj=1,Nrecord) write(200+i_node)(VYbp(jj,myOMP),jj=1,Nrecord) write(200+i_node)(VZbp(jj,myOMP),jj=1,Nrecord) write(200+i_node) (IDb(jj,myOMP),jj=1,Nrecord) write(200+i_node) (Wbpar(jj,myOMP),jj=1,Nrecord) End If close(200+i_node) write(*,'(a,i5,a,3i4,a,i11,a,6f8.3)') ' Region= ',i_node,' ijk=', i0,j0,k0, & ' N=',jCount(i_node),' bounds: ',xL,xR,yL,yR,zL,zR Nnx(i0) =Nnx(i0) + jCount(i_node) Nny(j0) =Nny(j0) + jCount(i_node) Nnz(k0) =Nnz(k0) + jCount(i_node) End SUBROUTINE Region_write !------------------------------------------------------------------- ! ! Add particles to buffer of this region ! dump on files, when buffer is full ! is,js,ks = periodic shift of particles ! SUBROUTINE Update_Region(xL,xR,yL,yR,zL,zR,Np,is,js,ks,i_node,myOMP) !------------------------------------------------------------------- Logical :: insidex,insidey,insidez Do i=1,Np xx = Xp(i,myOMP) + is*NGRID yy = Yp(i,myOMP) + js*NGRID zz = Zp(i,myOMP) + ks*NGRID insidex = .false. insidey = .false. insidez = .false. If(xx.ge.xL.and.xx.lt.xR)insidex =.true. If(yy.ge.yL.and.yy.lt.yR)insidey =.true. If(zz.ge.zL.and.zz.lt.zR)insidez =.true. If(insidex.and.insidey.and.insidez)Then jCount(i_node) = jCount(i_node) +1 ! global counter iCount(i_node) = iCount(i_node) +1 ! currently in this buffer ii = iCount(i_node) !if(mod(i,1000000)==0)write(*,*) 'Npart=',i Xbp(ii,myOMP) = xx Ybp(ii,myOMP) = yy Zbp(ii,myOMP) = zz VXbp(ii,myOMP) = VXp(i,myOMP) VYbp(ii,myOMP) = VYp(i,myOMP) VZbp(ii,myOMP) = VZp(i,myOMP) IDb(ii,myOMP) = IDs(i,myOMP) Wbpar(ii,myOMP) = Wpar(i,myOMP) If(ii .ge.NPAGE)Then Nrecord = ii write(200+i_node)Nrecord write(200+i_node)(Xbp(jj,myOMP),jj=1,Nrecord) write(200+i_node)(Ybp(jj,myOMP),jj=1,Nrecord) write(200+i_node)(Zbp(jj,myOMP),jj=1,Nrecord) write(200+i_node)(VXbp(jj,myOMP),jj=1,Nrecord) write(200+i_node)(VYbp(jj,myOMP),jj=1,Nrecord) write(200+i_node)(VZbp(jj,myOMP),jj=1,Nrecord) write(200+i_node) (IDb(jj,myOMP),jj=1,Nrecord) write(200+i_node) (Wbpar(jj,myOMP),jj=1,Nrecord) iCount(i_node) =0 ! re-start this buffer End If End If end Do end SUBROUTINE Update_Region ! ----------------------------------- subroutine Overlap(xL,xR,xbL,xbR,i_over,imap) ! ----------------------------------- ! find whether two intervals overlap ! use periodical boundary conditions Integer*4 :: imap(-1:1) i_over = 0 imap = 0 Do i=-1,1 x0 = xbL+i*NGRID ; x1 = xbR+i*NGRID If(min(x1,xR).gt.max(x0,xL))Then i_over =i_over+1 imap(i) = 1 EndIf EndDo end subroutine Overlap ! ----------------------------------- subroutine Init_Read (i_case) ! ----------------------------------- ! ! purpose: read header of first file to get ! number of particles CHARACTER*128 fname1,fname2 Integer*8 :: isum_test node = 1 ! construct file names --------------------------- If(i_case == 0)Then write(fname1,10)'RUN/PMPICrd.',node,'.DAT' write(fname2,10)'RUN/PMPICrs.',node,'.DAT' 10 format(a,i4.4,a) 20 format(a,i4.4,a,i4.4,a) Else write(fname1,20)'SNAP/PMPICrd.',node,'.',moment,'.DAT' write(fname2,20)'SNAP/PMPICrs.',node,'.',moment,'.DAT' ENDIF ! read header info from node01 i_name =600 write(*,'(20("-"),"reading ",a)') TRIM(fname1) OPEN(i_name,file = TRIM(fname1), & FORM = 'UNFORMATTED', STATUS = 'OLD') read (i_name) HEADER, & AEXPN,AEXP0,AMPLT,ASTEP,ISTEP,PARTW, & TINTG,EKIN,EKIN1,EKIN2,AU0,AEU0, & NROWC,NGRIDC,Nspecs,Nseed,Om0,Oml0,hubble,Wp5 & ,Ocurv,extras Box = extras(100) write (10,'(a,f8.5,a,i5,a,f8.2)') & ' AEXPN=',AEXPN,' STEP=',ISTEP,' Box=',Box read (i_name) n_divvX,n_divvY,n_divvZ, n_nodess IF(n_divvX .NE. n_divX) THEN write(*,*) ' Error: wrong n_divX. Read=',n_divvX, & ' vallue in parameter=',n_divX write(*,*) ' Read: n_dix,y,z=',n_divvX,n_divvY,n_divvZ write(*,*) ' n_nodes =',n_nodess STOP ENDIF IF(n_divvY .NE. n_divY) THEN write(*,*) ' Error: wrong n_divY. Read=',n_divvY, & ' vallue in parameter=',n_divY write(*,*) ' Read: n_dix,y,z=',n_divvX,n_divvY,n_divvZ write(*,*) ' n_nodes =',n_nodess STOP ENDIF IF(n_divvZ .NE. n_divZ) THEN write(*,*) ' Error: wrong n_divZ. Read=',n_divvZ, & ' vallue in parameter=',n_divZ write(*,*) ' Read: n_dix,y,z=',n_divvX,n_divvY,n_divvZ write(*,*) ' n_nodes =',n_nodess STOP ENDIF read (i_name) l_divX,l_divY,l_divZ read (i_name) (np_sb(inode) ,inode = 1,n_nodes) write(*,'(" ldivx =",10i4)')l_divX write(*,'(" Particles=",T20,6i10,/(T20,6i10))') & (np_sb(i),i=1,n_nodes) write(10,'(" ldivx =",10i4)')l_divX write(10,'(" ldivy =",10i4)') Do j=1,n_divY write(10,'(12x,20i4)')l_divY(:,j) EndDo write(10,'(" ldivz =",10i4)') Do k=1,n_divZ write(10,*) k write(10,'(12x,6(6i4,3x))')((l_divZ(i,j,k),i=1,n_divX),j=1,n_divY) EndDo write(10,'(" Particles=",T20,6i10,/(T20,6i10))') & (np_sb(i),i=1,n_nodes) max_test = 0 isum_test = 0 DO inode = 1,n_nodes max_test = max(max_test,np_sb(inode)) isum_test = isum_test + np_sb(inode) ENDDO Np_max = max_test write(*,'(5x,a,i11)')'Maximum number of particles = ',Np_max write(*,'(5x,a,i11)')'Total number = ',isum_test IF(isum_test.NE.lspecies(Nspecies))Then write(*,*)'ERROR !!Npart Sum Nodes=',isum_test, & ' Not=lspecies=',lspecies(Nspecies) write(*,'(" Particles=",T20,16i8,/(T20,16i8))') & (np_sb(i),i=1,n_nodes) Stop EndIf CLOSE(i_name) End subroutine Init_Read ! ----------------------------------- subroutine Read_MPI (i_case,m_node,myOMP) ! ----------------------------------- ! ! purpose: read particle coordinates, velocities, masses, and IDs ! Real*8, Allocatable, Dimension(:) :: dm Integer*8, Allocatable, Dimension(:) :: dmi Real*4, Allocatable, Dimension(:) :: dmr CHARACTER*128 fname1,fname2 real*8 :: xmin,xmax,ymin,ymax,zmin,zmax integer*8 :: i_min,i_max Integer*8 :: i,ii,isum_test Np = np_sb(m_node) Allocate(dm(Np),dmr(Np),dmi(Np)) ! construct file names --------------------------- If(i_case == 0)Then write(fname1,10)'RUN/PMPICrd.',m_node,'.DAT' write(fname2,10)'RUN/PMPICrs.',m_node,'.DAT' 10 format(a,i4.4,a) 20 format(a,i4.4,a,i4.4,a) Else write(fname1,20)'SNAP/PMPICrd.',m_node,'.',moment,'.DAT' write(fname2,20)'SNAP/PMPICrs.',m_node,'.',moment,'.DAT' ENDIF ! read header info from node01 i_name =600+myOMP write(10+myOMP,'(20("-"),"reading ",a,i6)') fname1 OPEN(i_name,file = TRIM(fname1), & FORM = 'UNFORMATTED', STATUS = 'OLD') read (i_name) HEADER, & AEXPN,AEXP0,AMPLT,ASTEP,ISTEP,PARTW, & TINTG,EKIN,EKIN1,EKIN2,AU0,AEU0, & NROWC,NGRIDC,Nspecs,Nseed,Om0,Oml0,hubble,Wp5 & ,Ocurv,extras !write (10+myOMP,*) ' AEXPN=',AEXPN,' STEP=',ISTEP read (i_name) n_divvX,n_divvY,n_divvZ, n_nodess IF(n_divvX .NE. n_divX) THEN write(*,*) ' Error: wrong n_divX. Read=',n_divvX, & ' vallue in parameter=',n_divX write(*,*) ' Read: n_dix,y,z=',n_divvX,n_divvY,n_divvZ write(*,*) ' n_nodes =',n_nodess STOP ENDIF IF(n_divvY .NE. n_divY) THEN write(*,*) ' Error: wrong n_divY. Read=',n_divvY, & ' vallue in parameter=',n_divY write(*,*) ' Read: n_dix,y,z=',n_divvX,n_divvY,n_divvZ write(*,*) ' n_nodes =',n_nodess STOP ENDIF IF(n_divvZ .NE. n_divZ) THEN write(*,*) ' Error: wrong n_divZ. Read=',n_divvZ, & ' vallue in parameter=',n_divZ write(*,*) ' Read: n_dix,y,z=',n_divvX,n_divvY,n_divvZ write(*,*) ' n_nodes =',n_nodess STOP ENDIF read (i_name) l_divX,l_divY,l_divZ read (i_name) (np_sb(inode) ,inode = 1,n_nodes) !write(10+myOMP,'(" ldivx =",10i4)')l_divX !write(10+myOMP,'(" Particles=",T20,8i10,/(T20,8i10))') & ! (np_sb(i),i=1,n_nodes) max_test = 0 isum_test = 0 DO inode = 1,n_nodes max_test = max(max_test,np_sb(inode)) isum_test = isum_test + np_sb(inode) ENDDO IF(isum_test.NE.lspecies(Nspecies))Then write(*,*)'ERROR !!Npart Sum Nodes=',isum_test, & ' Not=lspecies=',lspecies(Nspecies) write(*,'(" Particles=",T20,16i8,/(T20,16i8))') & (np_sb(i),i=1,n_nodes) Stop EndIf CLOSE(i_name) i_name = 600+myOMP !write(10+myOMP,'(20("-"),"reading ",a,i4)') TRIM(fname2),i_name-600 OPEN(i_name,file = TRIM(fname2), & FORM = 'UNFORMATTED', STATUS = 'OLD') read(i_name) np_this_node ,ng1,istepn READ(i_name) l_div_x1,l_div_x2,l_div_y1,l_div_y2, & l_div_z1,l_dix_z2 write(10+myOMP,300) m_node,np_this_node,ngridc,istep,np_sb(m_node),myOMP write(*,300) m_node,np_this_node,ngridc,istep,np_sb(m_node),myOMP 300 FORMAT(' node = ',I4, ' np_this_node = ', & I8, ' ng = ',I4, ' istep = ',I4,' np_sb(node)=',i16,' OMP=',i5) ! write(*,'(" borders of subbox: ",3(3x,2i5))') & ! l_div_x1,l_div_x2,l_div_y1,l_div_y2, & ! l_div_z1,l_dix_z2 read(i_name) dm ! read coordinates Do i=1, Np Xp(i,myOMP)=dm(i) EndDo read(i_name) dm Do i=1, Np Yp(i,myOMP)=dm(i) EndDo read(i_name) dm Do i=1, Np Zp(i,myOMP)=dm(i) EndDo read(i_name) dm ! read velocities Do i=1, Np VXp(i,myOMP)=dm(i) EndDo read(i_name) dm Do i=1, Np VYp(i,myOMP)=dm(i) EndDo read(i_name) dm Do i=1, Np VZp(i,myOMP)=dm(i) EndDo read(i_name) dmr ! read particle times !Do i=1, np_sb(node) ! pt(i+ii)=dmr(i) !EndDo read(i_name) dmr ! read weights Do i=1, Np Wpar(i,myOMP)=dmr(i) EndDo read(i_name) dmi ! read IDs Do i=1, Np IDs(i,myOMP)=dmi(i) EndDo !write(10+myOMP,*) ' finished node=',m_node !write(*,*) (dmi(i),i=np_sb(node)-10,np_sb(node)) CLOSE(i_name) DEAllocate(dm,dmr,dmi) !stop ' ---- test ----' xmin = 1.E9 xmax = -1.E9 ymin = 1.E9 ymax = -1.E9 zmin = 1.E9 zmax = -1.E9 i_min = 4096**3 ! two very large numbers i_max = -4096**3 Do i=1,Np xmin =MIN(xmin,xp(i,myOMP)) ymin =MIN(ymin,yp(i,myOMP)) zmin =MIN(zmin,zp(i,myOMP)) xmax =MAX(xmax,xp(i,myOMP)) ymax =MAX(ymax,yp(i,myOMP)) zmax =MAX(zmax,zp(i,myOMP)) if(i_min>IDS(i,myOMP))i_min=IDS(i,myOMP) i_max =MAX(i_max,IDS(i,myOMP)) if(IDS(i,myOMP).le.0) & write(10+myOMP,'(3x,a,i9,i11,3x,1p,3g12.3))') & 'ID error:',i,IDS(i,myOMP),xp(i,myOMP),yp(i,myOMP),zp(i,myOMP) enddo write(10+myOMP,'(4(12x,a,8x))')'xmin/max','ymin/max','zmin/max','imin/max' write(10+myOMP,'(3(2x,2g13.7),2x,2i12)')xmin,xmax,ymin,ymax, & zmin,zmax,i_min,i_max write(10+myOMP,*) end subroutine Read_MPI !----------------------------------------------------------- End Module SetArrs !---------------------------------------------- Program MPItoPMss use SetArrs Integer*8 :: in Integer OMP_GET_THREAD_NUM, OMP_GET_MAX_THREADS Character*80 :: fname N_omp = OMP_GET_MAX_THREADS() Do i=1,N_omp write(fname,'(a,i4.4,a)')'Output.',i,'.dat' open(10+i,file=fname) EndDo memory = 0.2 ! initial memory Write(*,'(a,$)') ' Enter snapshot or 0 for current moment= ' Read(*,*) i_case write(*,*) write(*,*) ' Number of OMP threads = ',n_omp write(fname,'(a,i4.4,a)')'Split.',i_case,'.dat' open(10,file=fname) if(i_case/=0)moment=i_case !---------------------- Initialize !Call Set_Boundaries CALL Init_Read(i_case) Allocate(Xp(Np_max,N_omp),Yp(Np_max,N_omp),Zp(Np_max,N_omp)) CALL Memory_Update(3_8*N_omp*Np_max) Allocate(VXp(Np_max,N_omp),VYp(Np_max,N_omp),VZp(Np_max,N_omp)) CALL Memory_Update(3_8*N_omp*Np_max) Allocate(Wpar(Np_max,N_omp),IDs(Np_max,N_omp)) CALL Memory_Update(3_8*N_omp*Np_max) Allocate(Xbp(NPAGE,N_omp),Ybp(NPAGE,N_omp),Zbp(NPAGE,N_omp)) CALL Memory_Update(3_8*N_omp*NPAGE) Allocate(VXbp(NPAGE,N_omp),VYbp(NPAGE,N_omp),VZbp(NPAGE,N_omp)) CALL Memory_Update(3_8*N_omp*NPAGE) Allocate(Wbpar(NPAGE,N_omp),IDb(NPAGE,N_omp)) CALL Memory_Update(3_8*N_omp*NPAGE) jCount = 0 ! initialize counters iCount = 0 Nnx =0 ; Nny =0 ; Nnz = 0 !$OMP PARALLEL DO DEFAULT(SHARED) & !$OMP PRIVATE (i) Do i =1,N_omp Xp(:,i) =0. ; Yp(:,i) =0. ; Zp(:,i) =0. VXp(:,i) =0. ; VYp(:,i) =0. ; VZp(:,i) =0. Wpar(:,i)=0. ; IDs(:,i) =0. Xbp(:,i) =0. ; Ybp(:,i) =0. ; Zbp(:,i) =0. VXbp(:,i) =0. ; VYbp(:,i) =0. ; VZbp(:,i) =0. Wbpar(:,i)=0. ; IDb(:,i) =0. EndDo ! --------------------- Main loop !$OMP PARALLEL DO DEFAULT(SHARED) & !$OMP PRIVATE (i_node,myOMP) schedule(dynamic,1) Do i_node = 1,Nfiles myOMP = OMP_GET_THREAD_NUM()+1 CALL Region_write(i_case,i_node,myOMP) EndDo ! ----------------------- print statistics write(10,'(a,3i4)') ' Particles on Nx/Ny/Nz regions: ',nx,ny,nz Do k=1,nz write(10,*) Do j=1,ny ii =(j-1)*nx+(k-1)*nx*ny write(10,'(10x,20i11)')(jCount(i+ii),i=1,nx) EndDo End Do write(10,'(a,20f10.2)') ' Boundaries along X =',BoundX write(10,'(a,3x,20i10)')' Number of particles (millions) =',Nnx/1000000 Do i =2,nx Nnx(i) = Nnx(i) +Nnx(i-1) EndDo write(10,'(36x,20i10)') Nnx/1000000 write(10,'(a,20f10.2)') ' Boundaries along Y =',BoundY write(10,'(a,3x,20i10)')' Number of particles (millions) =',Nny/1000000 Do i =2,ny Nny(i) = Nny(i) +Nny(i-1) EndDo write(10,'(36x,20i10)') Nny/1000000 write(10,'(a,20f10.2)') ' Boundaries along Z =',BoundZ write(10,'(a,3x,20i10)')' Number of particles (millions) =',Nnz/1000000 Do i =2,nz Nnz(i) = Nnz(i) +Nnz(i-1) EndDo write(10,'(36x,20i10)') Nnz/1000000 end Program MPItoPMss !----------------------------------------------------------- SUBROUTINE Memory_Update(in) use SetArrs real*4, parameter :: Gb = 1024.**3 integer*8 :: in memory = memory + in*4/Gb write (*,'(15x,a,1p,g12.4)') 'Memory/Gb = ',memory end SUBROUTINE Memory_Update