Skip to content
read_b_asc.F90 3.21 KiB
Newer Older
Fabio Roberto Vitello's avatar
Fabio Roberto Vitello committed
!***********************************************************************
!
!
                           SUBROUTINE read_b_asc
!
!
!***********************************************************************
!
!
!     Subroutine to read in the data associated with the bodies from
!     the ASCII input file.  
!=======================================================================

	 USE fly_h 
	 implicit none	 
	
	INCLUDE 'mpif.h'

!   Declaration of local variables.
!   -------------------------------
	
	INTEGER(KIND=MPI_ADDRESS_KIND) :: startIndex 
        INTEGER :: p,tag,istatus(MPI_STATUS_SIZE)
        CHARACTER(LEN=4) :: ifl      
	CHARACTER(LEN=256) :: name_file
!
!
! mass_read is the value of the mass of each body of the simulation
!
!=======================================================================
!   propagate the mass_read value to all bodies
	
	DO p=1,nb_res_loc(me+1)
            mass(p)=mass_read
        ENDDO

!   Read in body data.
!   ------------------
        
	IF(nbodies.GT.nbodsmax)                                         &
          CALL error('read_b_asc error1: inconsistent input')
 	
	
	IF (me.EQ.0) THEN 	!  PE0 execute the read operation
	pos_rmt=0.0
!   Open input 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

        name_file=TRIM(name_file)//ifl 
        
	OPEN(UNIT=ubodsin,FILE=name_file,STATUS='OLD')

	   DO p=1,nb_res_loc(me+1)

               READ(ubodsin,*) pos(1,p),pos(2,p),pos(3,p)  

	   ENDDO

		
	  DO PE_indx=1,NPES-1   ! read and transmit
	   
	   DO p=1,nb_res_loc(PE_indx+1)

               READ(ubodsin,*) pos_rmt(1,p),pos_rmt(2,p),pos_rmt(3,p)  

	   ENDDO
	   NLONG=nb_res_loc(PE_indx+1)*3
	   
	   
		tag = 1
	   CALL MPI_SEND(pos_rmt(1,1),NLONG, MPI_REAL8, PE_indx, tag, MPI_COMM_WORLD, ierror)

          ENDDO

	   DO p=1,nb_res_loc(me+1)

               READ(ubodsin,*) vel(1,p),vel(2,p),vel(3,p)  

	   ENDDO
	  
	  DO PE_indx=1,NPES-1   ! read and transmit

	   DO p=1,nb_res_loc(PE_indx+1)

               READ(ubodsin,*) pos_rmt(1,p),pos_rmt(2,p),pos_rmt(3,p)  

	   ENDDO
	   
	   NLONG=nb_res_loc(PE_indx+1)*3
		
		tag = 2
	   CALL MPI_SEND(pos_rmt(1,1),NLONG, MPI_REAL8, PE_indx, tag, MPI_COMM_WORLD,  ierror)


          ENDDO

	

100 	FORMAT(3(1X,F20.10))
        
	CLOSE(ubodsin)

		
	ELSE    ! IF (me.eq.NPES-1)
	   NLONG=nb_res_loc(me+1)*3
	   
	   tag=1
	   
           CALL MPI_RECV(pos(1,1), NLONG, MPI_REAL8, PE0, tag, MPI_COMM_WORLD, istatus, ierror)			
	   
	   tag=2
	   
           CALL MPI_RECV(vel(1,1), NLONG, MPI_REAL8, PE0, tag, MPI_COMM_WORLD, istatus, ierror)			


	ENDIF  ! IF (me.eq.NPES-1)
	
  	
	CALL MPI_BARRIER(MPI_COMM_WORLD,ierror)		

	IF(me.eq.0) THEN
	write(uterm,*)' pos first = ', pos(1:3,1)
	write(uterm,*) 'vel first = ', vel(1:3,1)
	call flush(uterm)
	ENDIF
	
	CALL MPI_BARRIER(MPI_COMM_WORLD,ierror)
	
	IF(me.eq.npes-1) THEN
	write(uterm,*) 'pos last  = ', pos(1:3,nb_res_loc(me+1))
	write(uterm,*) 'vel last  = ', vel(1:3,nb_res_loc(me+1))
	call flush(uterm)
	ENDIF
       
	RETURN
        END