Skip to content
write_b_bin.F90 5.66 KiB
Newer Older
Fabio Roberto Vitello's avatar
Fabio Roberto Vitello committed
!-----------------------------------------------------------------------
!
!
!
                          SUBROUTINE write_b_bin
!
!
!-----------------------------------------------------------------------
!
!
!     Subroutine to output the body data to binary output file.
!
!
!-----------------------------------------------------------------------

	 USE fly_h 
	 implicit none
	 INCLUDE 'mpif.h'
	

!   Declaration of local variables.
!  -------------------------------
        
	INTEGER :: tag,istatus(MPI_STATUS_SIZE),m1  
        INTEGER(KIND=4) ::tstep_old

	REAL(KIND=8) :: znow_old,pstat_old,gr_stat_old
        CHARACTER(LEN=4) ::ifl
	CHARACTER(LEN=256) :: name_file
	CHARACTER(LEN=261) :: name_hea
        CHARACTER(LEN=5) :: hea
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
! WARNING pos_cell is used as temporary array to store remote data
!-----------------------------------------------------------------------
!         
	 pos_cell=0.0
	 	 m1=-1

!-----------------------------------------------------------------------
!   Output system state.
!-----------------------------------------------------------------------
	 
	 CALL MPI_BARRIER(MPI_COMM_WORLD,ierror) 	
	
	IF(me.eq.0) THEN

!----------------------------------------------------------------------- 
!   Open output ascii body data file.
!-----------------------------------------------------------------------
	
	name_file=ibodfile
        
	IF(tstep.GT.1000) WRITE(ifl,'(I4.4)') tstep
        IF(tstep.GE.100 .AND. tstep .LT. 1000) WRITE(ifl,'(I3.3)') tstep
        IF(tstep.GE.10 .AND. tstep .LT. 100) WRITE(ifl,'(I2.2)') tstep
        IF(tstep.LT. 10) WRITE(ifl,'(I1.1)') tstep
		IF(inasc.eq.'R') WRITE(ifl,'(I2)') m1 
        
	name_file=TRIM(name_file)//ifl 
  	
	hea='_head'	
	name_hea=TRIM(name_file)//hea
	
	call c_open_wb_bin(name_file)
	   
	   nlong=nb_res_loc(me+1)*3
	   
	   call c_write_b_bin(pos(1,1),nlong)
	 
	 tag=1
	  DO PE_indx=1,NPES-1   ! read and transmit
	  
	   NLONG=nb_res_loc(pe_indx+1)*3
 	   
	   CALL MPI_RECV(pos_cell(1,1), NLONG, MPI_REAL8, PE_indx, tag, MPI_COMM_WORLD, istatus, ierror)			
	   
	   call c_write_b_bin(pos_cell(1,1),nlong)
          
	  ENDDO

	pos_cell=0
	
	   nlong=nb_res_loc(me+1)*3
	   
	   call c_write_b_bin(vel(1,1),nlong)
	 
	 tag=2
	  DO PE_indx=1,NPES-1   ! read and transmit
	   
	   nlong=nb_res_loc(pe_indx+1)*3
 	   
	   CALL MPI_RECV(pos_cell(1,1), NLONG, MPI_REAL8, PE_indx, tag, MPI_COMM_WORLD, istatus, ierror)			
	   
	   call c_write_b_bin(pos_cell(1,1),nlong)
          
	  ENDDO
	
	pos_cell=0

	   
	   call c_close_b_bin()

!----------------------------------------------------------------------- 
!   Write header file
!-----------------------------------------------------------------------
 	
	OPEN(UNIT=upar3,FILE=name_hea,STATUS='UNKNOWN')
	   
        WRITE(upar3,10) 'CURR.REDS=',znow
        WRITE(upar3,15) 'CURR.STEP=',tstep
        WRITE(upar3,10) 'DTIME    =',dtime
        
	CLOSE(upar3)	  

!----------------------------------------------------------------------- 
!   update dyn_pars file
!----------------------------------------------------------------------- 
        
	OPEN(UNIT=upar1,FILE=par1file,STATUS='UNKNOWN')
        
	READ(upar1,100) znow_old
        READ(upar1,150) tstep_old
        READ(upar1,150) tst_max
        READ(upar1,150) ncrit
        READ(upar1,150) nbodcrit        
        READ(upar1,113) pstat_old        
        READ(upar1,113) gr_stat_old       
        READ(upar1,150) l_end
        READ(upar1,220) rsize
        READ(upar1,250) rmin(1)
        READ(upar1,250) rmin(2)
        READ(upar1,250) rmin(3)
        
	CLOSE(unit=upar1)
        
	OPEN(UNIT=upar1,FILE=par1file,STATUS='UNKNOWN')
        
	WRITE(upar1,10) 'CURR.REDS=',znow
        WRITE(upar1,15) 'CURR.STEP=',tstep
        WRITE(upar1,15) 'MAX  STEP=',tst_max
        WRITE(upar1,15) 'LIV. GROU=',ncrit
        WRITE(upar1,15) 'BODY GRO.=',nbodcrit        
        WRITE(upar1,13) 'BAL. PAR =',pstat        
        WRITE(upar1,13) 'GR.  PAR =',gr_stat        
        WRITE(upar1,15) 'SORT_LEV.=',l_end
        WRITE(upar1,22) 'BOX SIZE =',rsize
        WRITE(upar1,25) 'X MIN VER=',rmin(1)
        WRITE(upar1,25) 'Y MIN VER=',rmin(2)
        WRITE(upar1,25) 'Z MIN VER=',rmin(3)
        
	CLOSE(upar1)

10      FORMAT(a10,F20.15)
13	FORMAT(a10,F5.2)
15      FORMAT(a10,I4)
16	FORMAT(a10,I5)
22      FORMAT(a10,F9.4)
25      FORMAT(a10,F10.6)
100      FORMAT(10x,F20.15)
113	FORMAT(10x,F5.2)
150      FORMAT(10x,I4)
220      FORMAT(10x,F9.4)
250      FORMAT(10x,F10.6)

!--------------------------------------------------------------- 
!   write ckstop file
!-----------------------------------------------------------------------
	
	IF(halt_sim.eq.0 .and. tst_max.gt.tstep) THEN  ! used to stop script run
	
	OPEN(UNIT=upar3,FILE='ckstop',STATUS='UNKNOWN')
	   
        WRITE(upar3,10) 'CURR.REDS=',znow
        WRITE(upar3,15) 'CURR.STEP=',tstep
        WRITE(upar3,15) 'MAX  STEP=',tst_max
        
	CLOSE(upar3)	  
	
	ENDIF !if tstep	   
	
	IF(halt_sim.eq.3 .and. tst_max.gt.tstep) THEN  ! used to stop script run
	
	OPEN(UNIT=upar3,FILE='ckstop',STATUS='UNKNOWN')
	   
        WRITE(upar3,10) 'CURR.REDS=',znow
        WRITE(upar3,15) 'CURR.STEP=',tstep
        WRITE(upar3,15) 'MAX  STEP=',tst_max
        
	CLOSE(upar3)	  
	
	ENDIF    
 	
	ELSE ! if me.eq.0    
 	   
	   NLONG=nb_res_loc(me+1)*3
	   
	   tag=1
           
	   CALL MPI_SEND(pos(1,1), NLONG, MPI_REAL8, PE0, tag, MPI_COMM_WORLD,  ierror)			
	   
	   tag=2
	   
           CALL MPI_SEND(vel(1,1), NLONG, MPI_REAL8, PE0, tag, MPI_COMM_WORLD,  ierror)			
	   
 	ENDIF ! if me.eq.0
         
	 CALL MPI_BARRIER(MPI_COMM_WORLD,ierror) 	
        
	RETURN
        END