89 lines
1.9 KiB
Fortran
Executable File
89 lines
1.9 KiB
Fortran
Executable File
! to_plot.f90
|
|
!
|
|
! FUNCTIONS:
|
|
! to_plot - Entry point of console application.
|
|
!
|
|
|
|
!****************************************************************************
|
|
!
|
|
! PROGRAM: to_plot
|
|
!
|
|
! PURPOSE: To put several *g_t files in a multicolumn file and in the ZF
|
|
! cases correct for the fact that all simulations were done
|
|
! with 50 degree phase angle (should have been 0 for ZF)
|
|
!
|
|
!****************************************************************************
|
|
|
|
program to_plot
|
|
|
|
implicit none
|
|
|
|
! Variables
|
|
|
|
integer*4 i,j,k,n,is,l,max_l
|
|
real*4 x(40,1000), y(40,1000), xi, yi, yj
|
|
character*512 out
|
|
character*80 filename, file_out
|
|
character*1 y_n
|
|
logical*4 ZF
|
|
|
|
! Body of to_plot
|
|
|
|
1 write(6,2)
|
|
2 format(' Give simulation numbers > '$)
|
|
read(5,*,err=1) is, k, n
|
|
3 write(6,4)
|
|
4 format(' Zero-Field ? '$)
|
|
read(5,'(a1)') y_n
|
|
ZF = ( y_n .EQ. 'y' .OR. y_n .EQ. 'Y' )
|
|
5 write(6,6)
|
|
6 format(' Give output file name > '$)
|
|
read(5,'(a80)') file_out
|
|
|
|
max_l = 0
|
|
x = 0.0
|
|
y = 0.0
|
|
|
|
DO i = k, n
|
|
write(filename,50) is, i
|
|
50 format('u:\simulations\dynamics-',i2,'_',i3,'.g_t')
|
|
write(6,*) filename
|
|
open(1,file=filename,status='old',err=55)
|
|
write(out( 14*(i-k)+1:14*(i-k+1) ),51) is,i
|
|
51 format(' time ',i2,'_',i3)
|
|
|
|
l = 0
|
|
|
|
read(1,*) xi, yi, yj
|
|
|
|
|
|
DO WHILE( xi .LT. 5.0 .AND. (.NOT. Eof(1) ) )
|
|
l = l + 1
|
|
IF ( ZF ) yi = sqrt( yi*yi + yj*yj )
|
|
x(i-k+1,l) = xi
|
|
y(i-k+1,l) = yi
|
|
read(1,*) xi, yi, yj
|
|
END DO
|
|
|
|
IF ( max_l .LT. l ) max_l = l
|
|
close(1)
|
|
|
|
55 END DO
|
|
|
|
open(2,file='u:\simulations\'//file_out,status='new')
|
|
write( 2, '(a)' ) out(1:14*(n-k+1))
|
|
|
|
DO j = 1, max_l
|
|
write(out,'(35(f6.3,f8.3))') ( (x(i,j),y(i,j)),i=1,n-k+1 )
|
|
DO i = 1, n-k+1
|
|
IF ( x(i,j) .LT. 0.0 ) out( 14*(i-1)+1:14*i ) = ' '
|
|
END DO
|
|
write(2,'(a)') out(1:14*(n-k+1))
|
|
END DO
|
|
|
|
close(2)
|
|
goto 1
|
|
|
|
end program to_plot
|
|
|