!----------------------------------------------------------------------- ! ! ! 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