00001
00002
00003
00004
00005
00006
00007
00008 module gnufor2
00009 implicit none
00010
00011
00012
00013 character(len=3), parameter :: default_linewidth='1'
00014 character(len=100), parameter :: default_color1='blue'
00015 character(len=100), parameter :: default_color2='dark-green'
00016 character(len=100), parameter :: default_color3='orange-red'
00017 character(len=100), parameter :: default_color4='dark-salmon'
00018 character(len=100), parameter :: default_terminal='wxt'
00019 character(len=100), parameter :: default_palette='CMY'
00020
00021 interface plot
00022 module procedure plot_1
00023 module procedure plot_2
00024 module procedure plot_3
00025 module procedure plot_4
00026 end interface
00027
00028 interface surf
00029 module procedure surf_1
00030 module procedure surf_2
00031 module procedure surf_3
00032 end interface
00033
00034 interface image
00035 module procedure image_1
00036 module procedure image_2
00037 module procedure image_3
00038 module procedure image_4
00039 end interface
00040
00041
00042
00043 contains
00044
00045
00046
00047 function my_date_and_time() result(f_result)
00048
00049
00050
00051
00052 implicit none
00053 character(len=8) :: date
00054 character(len=10) :: time
00055 character(len=33) :: f_result
00056
00057 call date_and_time(date,time)
00058 f_result= 'date_'//date(7:8)//'-'//date(5:6)//'-'//date(1:4)//'_time_'//time(1:2)//':'//time(3:4)//':'//time(5:10)
00059
00060 end function my_date_and_time
00061
00062
00063
00064 function output_terminal(terminal) result(f_result)
00065
00066 implicit none
00067 character(len=*),intent(in) :: terminal
00068 integer, parameter :: Nc=35
00069 character(len=Nc) :: f_result
00070
00071 select case(terminal)
00072 case('ps')
00073 f_result='postscript landscape color'
00074 case default
00075 f_result=terminal
00076 end select
00077
00078 end function output_terminal
00079
00080
00081
00082 subroutine image_4(x,y,rgb,pause,terminal,filename,persist,input)
00083
00084
00085
00086
00087 implicit none
00088 real(kind=4), intent(in) :: x(:), y(:)
00089 integer,intent(in) :: rgb(:,:,:)
00090 real(kind=4), optional :: pause
00091 character(len=*),optional :: terminal, filename, persist, input
00092 integer :: nx, ny
00093 integer :: i, j, ierror, ios, file_unit
00094 character(len=100) :: data_file_name, command_file_name, my_pause, my_persist,
00095 xrange1,xrange2,yrange1,yrange2
00096
00097 nx=size(rgb(1,:,1))
00098 ny=size(rgb(1,1,:))
00099 if ((size(x).ne.nx).or.(size(y).ne.ny)) then
00100 ierror=1
00101 print *,'image2 ERROR: sizes of x(:),y(:) and gray(:,:) are not compatible'
00102 stop
00103 end if
00104 write (xrange1,'(e15.7)') minval(x)
00105 write (xrange2,'(e15.7)') maxval(x)
00106 write (yrange1,'(e15.7)') minval(y)
00107 write (yrange2,'(e15.7)') maxval(y)
00108 do j=1,ny
00109 do i=1,nx
00110 if ((maxval(rgb(:,i,j))>255).or.(minval(rgb(:,i,j))<0)) then
00111 print *,'image ERROR: a value of rgb(:,:,:) array is outside [0,255]'
00112 stop
00113 end if
00114 end do
00115 end do
00116
00117 if (present(input)) then
00118 data_file_name='data_file_'//input//'.txt'
00119 command_file_name='command_file_'//input//'.txt'
00120 else
00121 data_file_name='data_file.txt'
00122 command_file_name='command_file.txt'
00123 end if
00124
00125 ierror=0
00126 call get_unit(file_unit)
00127 if (file_unit==0) then
00128 ierror=1
00129 print *,'write_vector_date - fatal error! Could not get a free FORTRAN unit.'
00130 stop
00131 end if
00132 open (unit=file_unit, file=data_file_name, status='replace', iostat=ios)
00133 if (ios/=0) then
00134 ierror=2
00135 print *,'write_vector_data - fatal error! Could not open the terminal data file.'
00136 stop
00137 end if
00138
00139
00140
00141 do j=1,ny
00142 do i=1,nx
00143 write (file_unit,'(2E12.4,3I5)') x(i),y(j),rgb(1,i,j),rgb(2,i,j),rgb(3,i,j)
00144 end do
00145 write (file_unit,'(a)')
00146 end do
00147
00148 close (unit=file_unit)
00149
00150 ierror = 0
00151 call get_unit(file_unit)
00152 if (file_unit==0) then
00153 ierror=1
00154 print *,'write_vector_date - fatal error! Could not get a free FORTRAN unit.'
00155 stop
00156 end if
00157 open (unit=file_unit, file=command_file_name, status='replace', iostat=ios)
00158 if (ios/=0) then
00159 ierror=2
00160 print *,'write_vector_data - fatal error! Could not open the terminal command file.'
00161 stop
00162 end if
00163
00164
00165
00166 my_persist='persist '
00167 if (present(persist).and.(persist=='no')) my_persist=' '
00168 if (present(terminal)) then
00169 write ( file_unit, '(a)' ) 'set terminal '// trim(output_terminal(terminal))
00170 if (present(filename)) then
00171 write ( file_unit, '(a)' ) 'set output "'// trim(filename) //'"'
00172 else
00173 write ( file_unit, '(a)' ) 'set output "'//my_date_and_time()//'"'
00174 end if
00175 else
00176 write ( file_unit, '(a)' ) 'set terminal ' // trim(default_terminal) // ' ' &
00177 & //trim(my_persist) // ' title "Gnuplot"'
00178 end if
00179
00180 write ( file_unit, '(a)' ) 'set nokey'
00181 write ( file_unit, '(a)' ) 'set xrange ['// trim(xrange1) // ':'// trim(xrange2) //']'
00182 write ( file_unit, '(a)' ) 'set yrange ['// trim(yrange1) // ':'// trim(yrange2) //']'
00183 write ( file_unit, '(a)' ) 'unset colorbox'
00184
00185 write ( file_unit, '(a)' ) 'plot "' // trim ( data_file_name ) // &
00186 & '" with rgbimage'
00187
00188 if (present(pause)) then
00189 if (pause<0.0) then
00190 write ( file_unit, '(a)' ) 'pause -1 "press RETURN to continue"'
00191 else
00192 write ( my_pause,'(e9.3)') pause
00193 write ( file_unit, '(a)' ) 'pause ' // trim(my_pause)
00194 end if
00195 else
00196 write ( file_unit, '(a)' ) 'pause 0'
00197 end if
00198
00199 write ( file_unit, '(a)' ) 'q'
00200 close ( unit = file_unit )
00201
00202 call run_gnuplot (command_file_name)
00203
00204 end subroutine image_4
00205
00206
00207
00208 subroutine image_3(rgb,pause,terminal,filename,persist,input)
00209
00210
00211
00212
00213 implicit none
00214 integer, intent(in) :: rgb(:,:,:)
00215 real(kind=4), optional :: pause
00216 character(len=*),optional :: terminal, filename, persist, input
00217 integer :: nx, ny
00218 integer :: i, j, ierror, ios, file_unit
00219 character(len=100) :: data_file_name, command_file_name, my_pause, my_persist
00220
00221 nx=size(rgb(1,:,1))
00222 ny=size(rgb(1,1,:))
00223 do j=1,ny
00224 do i=1,nx
00225 if ((maxval(rgb(:,i,j))>255).or.(minval(rgb(:,i,j))<0)) then
00226 print *,'image ERROR: a value of rgb(:,:,:) array is outside [0,255]'
00227 stop
00228 end if
00229 end do
00230 end do
00231
00232 if (present(input)) then
00233 data_file_name='data_file_'//input//'.txt'
00234 command_file_name='command_file_'//input//'.txt'
00235 else
00236 data_file_name='data_file.txt'
00237 command_file_name='command_file.txt'
00238 end if
00239
00240 ierror=0
00241 call get_unit(file_unit)
00242 if (file_unit==0) then
00243 ierror=1
00244 print *,'write_vector_date - fatal error! Could not get a free FORTRAN unit.'
00245 stop
00246 end if
00247 open (unit=file_unit, file=data_file_name, status='replace', iostat=ios)
00248 if (ios/=0) then
00249 ierror=2
00250 print *,'write_vector_data - fatal error! Could not open the terminal data file.'
00251 stop
00252 end if
00253
00254
00255
00256 do j=1,ny
00257 do i=1,nx
00258 write (file_unit,'(5I5)') i,j,rgb(1,i,j),rgb(2,i,j),rgb(3,i,j)
00259 end do
00260 write (file_unit,'(a)')
00261 end do
00262
00263 close (unit=file_unit)
00264
00265 ierror = 0
00266 call get_unit(file_unit)
00267 if (file_unit==0) then
00268 ierror=1
00269 print *,'write_vector_date - fatal error! Could not get a free FORTRAN unit.'
00270 stop
00271 end if
00272 open (unit=file_unit, file=command_file_name, status='replace', iostat=ios)
00273 if (ios/=0) then
00274 ierror=2
00275 print *,'write_vector_data - fatal error! Could not open the terminal command file.'
00276 stop
00277 end if
00278
00279
00280
00281 my_persist='persist '
00282 if (present(persist).and.(persist=='no')) my_persist=' '
00283 if (present(terminal)) then
00284 write ( file_unit, '(a)' ) 'set terminal '// trim(output_terminal(terminal))
00285 if (present(filename)) then
00286 write ( file_unit, '(a)' ) 'set output "'// trim(filename) //'"'
00287 else
00288 write ( file_unit, '(a)' ) 'set output "'//my_date_and_time()//'"'
00289 end if
00290 else
00291 write ( file_unit, '(a)' ) 'set terminal ' // trim(default_terminal) // ' ' &
00292 & //trim(my_persist) // ' title "Gnuplot"'
00293 end if
00294
00295 write ( file_unit, '(a)' ) 'set nokey'
00296 write ( file_unit, '(a)' ) 'unset border'
00297 write ( file_unit, '(a)' ) 'unset xtics'
00298 write ( file_unit, '(a)' ) 'unset ytics'
00299 write ( file_unit, '(a)' ) 'unset colorbox'
00300
00301 write ( file_unit, '(a)' ) 'plot "' // trim ( data_file_name ) // &
00302 & '" with rgbimage'
00303
00304 if (present(pause)) then
00305 if (pause<0.0) then
00306 write ( file_unit, '(a)' ) 'pause -1 "press RETURN to continue"'
00307 else
00308 write ( my_pause,'(e9.3)') pause
00309 write ( file_unit, '(a)' ) 'pause ' // trim(my_pause)
00310 end if
00311 else
00312 write ( file_unit, '(a)' ) 'pause 0'
00313 end if
00314
00315 write ( file_unit, '(a)' ) 'q'
00316 close ( unit = file_unit )
00317
00318 call run_gnuplot (command_file_name)
00319
00320 end subroutine image_3
00321
00322
00323
00324 subroutine image_2(x,y,gray,pause,palette,terminal,filename,persist,input)
00325
00326
00327
00328
00329 implicit none
00330 real(kind=4), intent(in) :: x(:), y(:), gray(:,:)
00331 real(kind=4), optional :: pause
00332 character(len=*),optional :: palette, terminal, filename, persist, input
00333 integer :: nx, ny
00334 integer :: i, j, ierror, ios, file_unit
00335 character(len=100) :: data_file_name, command_file_name, my_pause, my_persist,
00336 xrange1,xrange2,yrange1,yrange2
00337
00338 nx=size(gray(:,1))
00339 ny=size(gray(1,:))
00340 if ((size(x).ne.nx).or.(size(y).ne.ny)) then
00341 ierror=1
00342 print *,'image2 ERROR: sizes of x(:),y(:) and gray(:,:) are not compatible'
00343 stop
00344 end if
00345 write (xrange1,'(e15.7)') minval(x)
00346 write (xrange2,'(e15.7)') maxval(x)
00347 write (yrange1,'(e15.7)') minval(y)
00348 write (yrange2,'(e15.7)') maxval(y)
00349
00350 if (present(input)) then
00351 data_file_name='data_file_'//input//'.txt'
00352 command_file_name='command_file_'//input//'.txt'
00353 else
00354 data_file_name='data_file.txt'
00355 command_file_name='command_file.txt'
00356 end if
00357
00358 ierror=0
00359 call get_unit(file_unit)
00360 if (file_unit==0) then
00361 ierror=1
00362 print *,'write_vector_date - fatal error! Could not get a free FORTRAN unit.'
00363 stop
00364 end if
00365 open (unit=file_unit, file=data_file_name, status='replace', iostat=ios)
00366 if (ios/=0) then
00367 ierror=2
00368 print *,'write_vector_data - fatal error! Could not open the terminal data file.'
00369 stop
00370 end if
00371
00372
00373
00374 do j=1,ny
00375 do i=1,nx
00376 write (file_unit,'(3E12.4)') x(i), y(j), gray(i,j)
00377 end do
00378 write (file_unit,'(a)')
00379 end do
00380
00381 close (unit=file_unit)
00382
00383 ierror = 0
00384 call get_unit(file_unit)
00385 if (file_unit==0) then
00386 ierror=1
00387 print *,'write_vector_date - fatal error! Could not get a free FORTRAN unit.'
00388 stop
00389 end if
00390 open (unit=file_unit, file=command_file_name, status='replace', iostat=ios)
00391 if (ios/=0) then
00392 ierror=2
00393 print *,'write_vector_data - fatal error! Could not open the terminal command file.'
00394 stop
00395 end if
00396
00397
00398
00399 my_persist='persist '
00400 if (present(persist).and.(persist=='no')) my_persist=' '
00401 if (present(terminal)) then
00402 write ( file_unit, '(a)' ) 'set terminal '// trim(output_terminal(terminal))
00403 if (present(filename)) then
00404 write ( file_unit, '(a)' ) 'set output "'// trim(filename) //'"'
00405 else
00406 write ( file_unit, '(a)' ) 'set output "'//my_date_and_time()//'"'
00407 end if
00408 else
00409 write ( file_unit, '(a)' ) 'set terminal ' // trim(default_terminal) // ' ' &
00410 & //trim(my_persist) // ' title "Gnuplot"'
00411 end if
00412
00413 write ( file_unit, '(a)' ) 'set nokey'
00414 write ( file_unit, '(a)' ) 'set xrange ['// trim(xrange1) // ':'// trim(xrange2) //']'
00415 write ( file_unit, '(a)' ) 'set yrange ['// trim(yrange1) // ':'// trim(yrange2) //']'
00416 write ( file_unit, '(a)' ) 'unset colorbox'
00417 if (present(palette)) then
00418 if ((trim(palette).ne.'RGB').and.(trim(palette).ne.'HSV').and.(trim(palette).ne.'CMY').and.&
00419 & (trim(palette).ne.'YIQ').and.(trim(palette).ne.'XYZ')) then
00420 write ( file_unit, '(a)' ) 'set palette '// trim(palette)
00421 else
00422 write ( file_unit, '(a)' ) 'set palette model '// trim(palette)
00423 end if
00424 else
00425 write ( file_unit, '(a)' ) 'set palette model '// trim(default_palette)
00426 end if
00427
00428 write ( file_unit, '(a)' ) 'plot "' // trim ( data_file_name ) // &
00429 & '" with image'
00430
00431 if (present(pause)) then
00432 if (pause<0.0) then
00433 write ( file_unit, '(a)' ) 'pause -1 "press RETURN to continue"'
00434 else
00435 write ( my_pause,'(e9.3)') pause
00436 write ( file_unit, '(a)' ) 'pause ' // trim(my_pause)
00437 end if
00438 else
00439 write ( file_unit, '(a)' ) 'pause 0'
00440 end if
00441
00442 write ( file_unit, '(a)' ) 'q'
00443 close ( unit = file_unit )
00444
00445 call run_gnuplot (command_file_name)
00446
00447 end subroutine image_2
00448
00449
00450
00451 subroutine image_1(gray,pause,palette,terminal,filename,persist,input)
00452
00453
00454
00455
00456 implicit none
00457 real(kind=4), intent(in) :: gray(:,:)
00458 real(kind=4), optional :: pause
00459 character(len=*),optional :: palette, terminal, filename, persist, input
00460 integer :: nx, ny
00461 integer :: i, j, ierror, ios, file_unit
00462 character(len=100) :: data_file_name, command_file_name, my_pause, my_persist
00463
00464 nx=size(gray(:,1))
00465 ny=size(gray(1,:))
00466
00467 if (present(input)) then
00468 data_file_name='data_file_'//input//'.txt'
00469 command_file_name='command_file_'//input//'.txt'
00470 else
00471 data_file_name='data_file.txt'
00472 command_file_name='command_file.txt'
00473 end if
00474
00475 ierror=0
00476 call get_unit(file_unit)
00477 if (file_unit==0) then
00478 ierror=1
00479 print *,'write_vector_date - fatal error! Could not get a free FORTRAN unit.'
00480 stop
00481 end if
00482 open (unit=file_unit, file=data_file_name, status='replace', iostat=ios)
00483 if (ios/=0) then
00484 ierror=2
00485 print *,'write_vector_data - fatal error! Could not open the terminal data file.'
00486 stop
00487 end if
00488
00489
00490
00491 do j=1,ny
00492 do i=1,nx
00493 write (file_unit,'(I5,I5,E15.7)') i,j,gray(i,j)
00494 end do
00495 write (file_unit,'(a)')
00496 end do
00497
00498 close (unit=file_unit)
00499
00500 ierror = 0
00501 call get_unit(file_unit)
00502 if (file_unit==0) then
00503 ierror=1
00504 print *,'write_vector_date - fatal error! Could not get a free FORTRAN unit.'
00505 stop
00506 end if
00507 open (unit=file_unit, file=command_file_name, status='replace', iostat=ios)
00508 if (ios/=0) then
00509 ierror=2
00510 print *,'write_vector_data - fatal error! Could not open the terminal command file.'
00511 stop
00512 end if
00513
00514
00515
00516 my_persist='persist '
00517 if (present(persist).and.(persist=='no')) my_persist=' '
00518 if (present(terminal)) then
00519 write ( file_unit, '(a)' ) 'set terminal '// trim(output_terminal(terminal))
00520 if (present(filename)) then
00521 write ( file_unit, '(a)' ) 'set output "'// trim(filename) //'"'
00522 else
00523 write ( file_unit, '(a)' ) 'set output "'//my_date_and_time()//'"'
00524 end if
00525 else
00526 write ( file_unit, '(a)' ) 'set terminal ' // trim(default_terminal) // ' ' &
00527 & //trim(my_persist) // ' title "Gnuplot"'
00528 end if
00529
00530 write ( file_unit, '(a)' ) 'set nokey'
00531 write ( file_unit, '(a)' ) 'unset border'
00532 write ( file_unit, '(a)' ) 'unset xtics'
00533 write ( file_unit, '(a)' ) 'unset ytics'
00534 write ( file_unit, '(a)' ) 'unset colorbox'
00535 if (present(palette)) then
00536 if ((trim(palette).ne.'RGB').and.(trim(palette).ne.'HSV').and.(trim(palette).ne.'CMY').and.&
00537 & (trim(palette).ne.'YIQ').and.(trim(palette).ne.'XYZ')) then
00538 write ( file_unit, '(a)' ) 'set palette '// trim(palette)
00539 else
00540 write ( file_unit, '(a)' ) 'set palette model '// trim(palette)
00541 end if
00542 else
00543 write ( file_unit, '(a)' ) 'set palette model '// trim(default_palette)
00544 end if
00545
00546 write ( file_unit, '(a)' ) 'plot "' // trim ( data_file_name ) // &
00547 & '" with image'
00548
00549 if (present(pause)) then
00550 if (pause<0.0) then
00551 write ( file_unit, '(a)' ) 'pause -1 "press RETURN to continue"'
00552 else
00553 write ( my_pause,'(e9.3)') pause
00554 write ( file_unit, '(a)' ) 'pause ' // trim(my_pause)
00555 end if
00556 else
00557 write ( file_unit, '(a)' ) 'pause 0'
00558 end if
00559
00560 write ( file_unit, '(a)' ) 'q'
00561 close ( unit = file_unit )
00562
00563 call run_gnuplot (command_file_name)
00564
00565 end subroutine image_1
00566
00567
00568
00569 subroutine plot3d(x,y,z,pause,color,terminal,filename,persist,input,linewidth)
00570
00571
00572
00573 implicit none
00574 real(kind=8), intent(in) :: x(:),y(:),z(:)
00575 real(kind=4), optional :: pause, linewidth
00576 character(len=*),optional :: color, terminal, filename, persist, input
00577 integer :: i, j, ierror, ios, file_unit, nx
00578 character(len=100) :: data_file_name, command_file_name, my_color, my_pause, my_persist, my_linewidth
00579
00580
00581 nx=size(x)
00582 if ((size(x).ne.size(y)).or.(size(x).ne.size(z))) then
00583 print *,'subroutine plot3d ERROR: incompatible sizes of x(:),y(:) and z(:)'
00584 stop
00585 end if
00586
00587 if (present(input)) then
00588 data_file_name='data_file_'//input//'.txt'
00589 command_file_name='command_file_'//input//'.txt'
00590 else
00591 data_file_name='data_file.txt'
00592 command_file_name='command_file.txt'
00593 end if
00594
00595 ierror=0
00596 call get_unit(file_unit)
00597 if (file_unit==0) then
00598 ierror=1
00599 print *,'write_vector_date - fatal error! Could not get a free FORTRAN unit.'
00600 stop
00601 end if
00602 open (unit=file_unit, file=data_file_name, status='replace', iostat=ios)
00603 if (ios/=0) then
00604 ierror=2
00605 print *,'write_vector_data - fatal error! Could not open the terminal data file.'
00606 stop
00607 end if
00608
00609
00610
00611 do i=1,nx
00612 write (file_unit,'(3E15.7)') x(i), y(i), z(i)
00613 end do
00614
00615 close (unit=file_unit)
00616
00617 ierror = 0
00618 call get_unit(file_unit)
00619 if (file_unit==0) then
00620 ierror=1
00621 print *,'write_vector_date - fatal error! Could not get a free FORTRAN unit.'
00622 stop
00623 end if
00624 open (unit=file_unit, file=command_file_name, status='replace', iostat=ios)
00625 if (ios/=0) then
00626 ierror=2
00627 print *,'write_vector_data - fatal error! Could not open the terminal command file.'
00628 stop
00629 end if
00630
00631
00632
00633 my_persist='persist'
00634 if (present(persist).and.(persist=='no')) my_persist=' '
00635 if (present(terminal)) then
00636 write ( file_unit, '(a)' ) 'set terminal '// trim(output_terminal(terminal))
00637 if (present(filename)) then
00638 write ( file_unit, '(a)' ) 'set output "'// trim(filename) //'"'
00639 else
00640 write ( file_unit, '(a)' ) 'set output "'//my_date_and_time()//'"'
00641 end if
00642 else
00643 write ( file_unit, '(a)' ) 'set terminal ' // trim(default_terminal) // ' ' &
00644 &// trim(my_persist) // ' title "Gnuplot"'
00645 end if
00646
00647 write ( file_unit, '(a)' ) 'set nokey'
00648
00649 if (present(linewidth)) then
00650 write ( my_linewidth,'(e9.3)') linewidth
00651 else
00652 my_linewidth=trim(default_linewidth)
00653 end if
00654 if (present(color)) then
00655 my_color='"'//trim(color)//'"'
00656 else
00657 my_color='"'//trim(default_color1)//'"'
00658 end if
00659 write ( file_unit, '(a)' ) 'splot "' // trim ( data_file_name ) // &
00660 '" using 1:2:3 with lines linecolor rgb' // my_color //' linewidth ' // my_linewidth
00661
00662 if (present(pause)) then
00663 if (pause<0.0) then
00664 write ( file_unit, '(a)' ) 'pause -1 "press RETURN to continue"'
00665 else
00666 write ( my_pause,'(e9.3)') pause
00667 write ( file_unit, '(a)' ) 'pause ' // trim(my_pause)
00668 end if
00669 else
00670 write ( file_unit, '(a)' ) 'pause 0'
00671 end if
00672
00673 write ( file_unit, '(a)' ) 'q'
00674 close ( unit = file_unit )
00675
00676 call run_gnuplot (command_file_name)
00677
00678 end subroutine plot3d
00679
00680
00681
00682 subroutine hist(x,n,pause,color,terminal,filename,persist,input)
00683
00684
00685
00686 implicit none
00687 real(kind=8), intent(in) :: x(:)
00688 integer, intent(in) :: n
00689 real(kind=4), optional :: pause
00690 character(len=*),optional :: color, terminal, filename, persist, input
00691 integer :: i, j, ierror, ios, file_unit, nx
00692 character(len=100) :: data_file_name, command_file_name, yrange, xrange1, xrange2, my_color,
00693 xtic_start, dxtic, xtic_end, my_pause, my_persist
00694 real(kind=8) :: xmin, xmax, xhist(0:n), yhist(n+1), dx
00695
00696
00697 nx=size(x)
00698 xmin=minval(x)
00699 xmax=maxval(x)
00700 dx=(xmax-xmin)/n
00701 do i=0,n
00702 xhist(i)=xmin+i*dx
00703 end do
00704 yhist=0.0d0
00705 do i=1,nx
00706 j=floor((x(i)-xmin)/dx)+1
00707 yhist(j)=yhist(j)+1
00708 end do
00709
00710 write (dxtic,'(e15.7)') dx
00711 write (yrange,'(e15.7)') maxval(yhist)*1.2
00712 write (xrange1,'(e15.7)') xmin-(n/10.0)*dx
00713 write (xrange2,'(e15.7)') xmax+(n/10.0)*dx
00714 xtic_start=xrange1
00715 xtic_end=xrange2
00716
00717 if (present(input)) then
00718 data_file_name='data_file_'//input//'.txt'
00719 command_file_name='command_file_'//input//'.txt'
00720 else
00721 data_file_name='data_file.txt'
00722 command_file_name='command_file.txt'
00723 end if
00724
00725 ierror=0
00726 call get_unit(file_unit)
00727 if (file_unit==0) then
00728 ierror=1
00729 print *,'write_vector_date - fatal error! Could not get a free FORTRAN unit.'
00730 stop
00731 end if
00732 open (unit=file_unit, file=data_file_name, status='replace', iostat=ios)
00733 if (ios/=0) then
00734 ierror=2
00735 print *,'write_vector_data - fatal error! Could not open the terminal data file.'
00736 stop
00737 end if
00738
00739
00740
00741 do i=1,n
00742 write (file_unit,'(2E15.7)') (xhist(i-1)+0.5*dx), yhist(i)
00743 end do
00744
00745 close (unit=file_unit)
00746
00747 ierror = 0
00748 call get_unit(file_unit)
00749 if (file_unit==0) then
00750 ierror=1
00751 print *,'write_vector_date - fatal error! Could not get a free FORTRAN unit.'
00752 stop
00753 end if
00754 open (unit=file_unit, file=command_file_name, status='replace', iostat=ios)
00755 if (ios/=0) then
00756 ierror=2
00757 print *,'write_vector_data - fatal error! Could not open the terminal command file.'
00758 stop
00759 end if
00760
00761
00762
00763 my_persist='persist'
00764 if (present(persist).and.(persist=='no')) my_persist=' '
00765 if (present(terminal)) then
00766 write ( file_unit, '(a)' ) 'set terminal '// trim(output_terminal(terminal))
00767 if (present(filename)) then
00768 write ( file_unit, '(a)' ) 'set output "'// trim(filename) //'"'
00769 else
00770 write ( file_unit, '(a)' ) 'set output "'//my_date_and_time()//'"'
00771 end if
00772 else
00773 write ( file_unit, '(a)' ) 'set terminal ' // trim(default_terminal) // ' ' &
00774 & //trim(my_persist) // ' title "Gnuplot"'
00775 end if
00776
00777 write ( file_unit, '(a)' ) 'set nokey'
00778 write ( file_unit, '(a)' ) 'set yrange [0.0:'// trim(yrange) //']'
00779 write ( file_unit, '(a)' ) 'set xrange ['// trim(xrange1) // ':'// trim(xrange2) //']'
00780 write ( file_unit, '(a)' ) 'set xtic nomirror rotate by -45 '
00781 write ( file_unit, '(a)' ) 'set xtics '// trim(xtic_start) // ','// trim(dxtic) // ','// trim(xtic_end)
00782 write ( file_unit, '(a)' ) 'set style data histograms'
00783 write ( file_unit, '(a)' ) 'set style fill solid border -1'
00784
00785 if (present(color)) then
00786 my_color='"'//color//'"'
00787 else
00788 my_color='"'//trim(default_color1)//'"'
00789 end if
00790 write ( file_unit, '(a)' ) 'plot "' // trim ( data_file_name ) // &
00791 '" using 1:2 with boxes linecolor rgb' // trim(my_color)
00792
00793 if (present(pause)) then
00794 if (pause<0.0) then
00795 write ( file_unit, '(a)' ) 'pause -1 "press RETURN to continue"'
00796 else
00797 write ( my_pause,'(e9.3)') pause
00798 write ( file_unit, '(a)' ) 'pause ' // trim(my_pause)
00799 end if
00800 else
00801 write ( file_unit, '(a)' ) 'pause 0'
00802 end if
00803
00804 write ( file_unit, '(a)' ) 'q'
00805 close ( unit = file_unit )
00806
00807 call run_gnuplot (command_file_name)
00808
00809 end subroutine hist
00810
00811
00812
00813 subroutine surf_3(x,y,z,pause,palette,terminal,filename,pm3d,contour,persist,input)
00814
00815
00816
00817
00818 implicit none
00819 real(kind=8), intent(in) :: x(:),y(:),z(:,:)
00820 real(kind=4), optional :: pause
00821 real(kind=8) :: xyz(3,size(z(:,1)),size(z(1,:)))
00822 character(len=*),optional :: palette, terminal, filename, pm3d, contour, persist, input
00823 integer :: nx, ny
00824 integer :: i, j
00825
00826 nx=size(z(:,1))
00827 ny=size(z(1,:))
00828 if ((size(x).ne.nx).or.(size(y).ne.ny)) then
00829 print *,'subroutine surf_3 ERROR: sizes of x(:),y(:), and z(:,:) are incompatible'
00830 stop
00831 end if
00832
00833 do i=1,nx
00834 do j=1,ny
00835 xyz(1,i,j)=x(i)
00836 xyz(2,i,j)=y(j)
00837 xyz(3,i,j)=z(i,j)
00838 end do
00839 end do
00840 call surf_1(xyz,pause,palette,terminal,filename,pm3d,contour,persist,input)
00841
00842 end subroutine surf_3
00843
00844
00845
00846 subroutine surf_2(z,pause,palette,terminal,filename,pm3d,contour,persist,input)
00847
00848
00849
00850
00851 implicit none
00852 real(kind=8), intent(in) :: z(:,:)
00853 real(kind=4), optional :: pause
00854 real(kind=8) :: xyz(3,size(z(:,1)),size(z(1,:)))
00855 character(len=*),optional :: palette, terminal, filename, pm3d, contour, persist, input
00856 integer :: nx, ny
00857 integer :: i, j
00858
00859 nx=size(z(:,1))
00860 ny=size(z(1,:))
00861 do i=1,nx
00862 do j=1,ny
00863 xyz(1,i,j)=dble(i)
00864 xyz(2,i,j)=dble(j)
00865 xyz(3,i,j)=z(i,j)
00866 end do
00867 end do
00868 call surf_1(xyz,pause,palette,terminal,filename,pm3d,contour,persist,input)
00869
00870 end subroutine surf_2
00871
00872
00873
00874 subroutine surf_1(xyz,pause,palette,terminal,filename,pm3d,contour,persist,input)
00875
00876
00877
00878
00879 implicit none
00880 real(kind=8), intent(in) :: xyz(:,:,:)
00881 real(kind=4), optional :: pause
00882 character(len=*),optional :: palette, terminal, filename, pm3d, contour, persist, input
00883 integer :: nx, ny, nrow
00884 integer :: i, j, ierror, ios, file_unit
00885 character(len=100) :: data_file_name, command_file_name, my_pause, my_persist
00886
00887 nx=size(xyz(1,:,1))
00888 ny=size(xyz(1,1,:))
00889 nrow=nx*ny
00890
00891 if (present(input)) then
00892 data_file_name='data_file_'//input//'.txt'
00893 command_file_name='command_file_'//input//'.txt'
00894 else
00895 data_file_name='data_file.txt'
00896 command_file_name='command_file.txt'
00897 end if
00898
00899 ierror=0
00900 call get_unit(file_unit)
00901 if (file_unit==0) then
00902 ierror=1
00903 print *,'write_vector_date - fatal error! Could not get a free FORTRAN unit.'
00904 stop
00905 end if
00906 open (unit=file_unit, file=data_file_name, status='replace', iostat=ios)
00907 if (ios/=0) then
00908 ierror=2
00909 print *,'write_vector_data - fatal error! Could not open the terminal data file.'
00910 stop
00911 end if
00912
00913
00914
00915 do j=1,ny
00916 do i=1,nx
00917 write (file_unit,'(3E15.7)') xyz(1:3,i,j)
00918 end do
00919 write (file_unit,'(a)')
00920 end do
00921
00922 close (unit=file_unit)
00923
00924 ierror = 0
00925 call get_unit(file_unit)
00926 if (file_unit==0) then
00927 ierror=1
00928 print *,'write_vector_date - fatal error! Could not get a free FORTRAN unit.'
00929 stop
00930 end if
00931 open (unit=file_unit, file=command_file_name, status='replace', iostat=ios)
00932 if (ios/=0) then
00933 ierror=2
00934 print *,'write_vector_data - fatal error! Could not open the terminal command file.'
00935 stop
00936 end if
00937
00938
00939
00940 my_persist='persist '
00941 if (present(persist).and.(persist=='no')) my_persist=' '
00942 if (present(terminal)) then
00943 write ( file_unit, '(a)' ) 'set terminal '// trim(output_terminal(terminal))
00944 if (present(filename)) then
00945 write ( file_unit, '(a)' ) 'set output "'// trim(filename) //'"'
00946 else
00947 write ( file_unit, '(a)' ) 'set output "'//my_date_and_time()//'"'
00948 end if
00949 else
00950 write ( file_unit, '(a)' ) 'set terminal ' // trim(default_terminal) // ' ' &
00951 & //trim(my_persist) // ' title "Gnuplot"'
00952 end if
00953
00954 write ( file_unit, '(a)' ) 'set nokey'
00955 if (present(palette)) then
00956 if ((trim(palette).ne.'RGB').and.(trim(palette).ne.'HSV').and.(trim(palette).ne.'CMY').and.&
00957 & (trim(palette).ne.'YIQ').and.(trim(palette).ne.'XYZ')) then
00958 write ( file_unit, '(a)' ) 'set palette '// trim(palette)
00959 else
00960 write ( file_unit, '(a)' ) 'set palette model '// trim(palette)
00961 end if
00962 else
00963 write ( file_unit, '(a)' ) 'set palette model '// trim(default_palette)
00964 end if
00965
00966 if (present(pm3d)) then
00967 write ( file_unit, '(a)' ) 'set '// pm3d
00968 else
00969 write ( file_unit, '(a)' ) 'set surface'
00970 if (present(contour)) then
00971 if (contour=='surface') then
00972 write ( file_unit, '(a)' ) 'set contour surface'
00973 elseif (contour=='both') then
00974 write ( file_unit, '(a)' ) 'set contour both'
00975 else
00976 write ( file_unit, '(a)' ) 'set contour'
00977 end if
00978 end if
00979 end if
00980 write ( file_unit, '(a)' ) 'set hidden3d'
00981 write ( file_unit, '(a)' ) 'set parametric'
00982
00983 write ( file_unit, '(a)' ) 'splot "' // trim ( data_file_name ) // &
00984 & '" using 1:2:3 with lines palette'
00985
00986 if (present(pause)) then
00987 if (pause<0.0) then
00988 write ( file_unit, '(a)' ) 'pause -1 "press RETURN to continue"'
00989 else
00990 write ( my_pause,'(e9.3)') pause
00991 write ( file_unit, '(a)' ) 'pause ' // trim(my_pause)
00992 end if
00993 else
00994 write ( file_unit, '(a)' ) 'pause 0'
00995 end if
00996
00997 write ( file_unit, '(a)' ) 'q'
00998 close ( unit = file_unit )
00999
01000 call run_gnuplot (command_file_name)
01001
01002 end subroutine surf_1
01003
01004
01005
01006 subroutine plot_4(x1,y1,x2,y2,x3,y3,x4,y4,style,pause,color1,color2,color3,color4,&
01007 & terminal,filename,polar,persist,input,linewidth)
01008
01009
01010
01011 implicit none
01012 real(kind=8), intent(in) :: x1(:), y1(:), x2(:), y2(:), x3(:), y3(:), x4(:), y4(:)
01013 real(kind=4), optional :: pause,linewidth
01014 character(len=*),optional :: style, color1, color2, color3, color4, terminal, filename, polar,
01015 persist, input
01016 integer :: i, ierror, ios, file_unit, Nx1, Nx2, Nx3, Nx4, Nmax
01017 character(len=100) :: data_file_name, command_file_name, my_linewidth
01018 integer, parameter :: Nc=20
01019 character(len=Nc) :: my_line_type1, my_line_type2, my_line_type3, my_line_type4,
01020 my_color1, my_color2, my_color3, my_color4, my_range, my_pause, my_persist
01021
01022 if (present(input)) then
01023 data_file_name='data_file_'//input//'.txt'
01024 command_file_name='command_file_'//input//'.txt'
01025 else
01026 data_file_name='data_file.txt'
01027 command_file_name='command_file.txt'
01028 end if
01029
01030 Nx1=size(x1)
01031 Nx2=size(x2)
01032 Nx3=size(x3)
01033 Nx4=size(x4)
01034 if ((size(x1).ne.size(y1)).or.(size(x2).ne.size(y2)).or.(size(x3).ne.size(y3)).or.(size(x4).ne.size(y4))) then
01035 print *,'subroutine plot ERROR: size(x) is not equal to size(y)'
01036 stop
01037 end if
01038 if (present(style).and.(len(style).ne.12)) then
01039 print *,'subroutine plot ERROR: argument "style" has wrong number of characters'
01040 stop
01041 end if
01042
01043 ierror=0
01044 call get_unit(file_unit)
01045 if (file_unit==0) then
01046 ierror=1
01047 print *,'write_vector_data - fatal error! Could not get a free FORTRAN unit.'
01048 stop
01049 end if
01050 open (unit=file_unit, file=data_file_name, status='replace', iostat=ios)
01051 if (ios/=0) then
01052 ierror=2
01053 print *,'write_vector_data - fatal error! Could not open the terminal data file.'
01054 stop
01055 end if
01056
01057
01058
01059 Nmax=max(Nx1,Nx2,Nx3,Nx4)
01060 do i=1,Nmax
01061 write (file_unit,'(8E15.7)') x1(min(i,Nx1)), y1(min(i,Nx1)), x2(min(i,Nx2)), y2(min(i,Nx2)), &
01062 & x3(min(i,Nx3)), y3(min(i,Nx3)), x4(min(i,Nx4)), y4(min(i,Nx4))
01063 end do
01064
01065 close (unit=file_unit)
01066
01067 ierror = 0
01068 call get_unit(file_unit)
01069 if (file_unit==0) then
01070 ierror=1
01071 print *,'write_vector_data - fatal error! Could not get a free FORTRAN unit.'
01072 stop
01073 end if
01074 open (unit=file_unit, file=command_file_name, status='replace', iostat=ios)
01075 if (ios/=0) then
01076 ierror=2
01077 print *,'write_vector_data - fatal error! Could not open the terminal command file.'
01078 stop
01079 end if
01080
01081
01082
01083 my_line_type1='lines'
01084 if (present(style)) then
01085 if ((style(3:3)=='-')) then
01086 my_line_type1='linespoints'
01087 else
01088 my_line_type1='points'
01089 end if
01090 end if
01091 my_line_type2='lines'
01092 if (present(style)) then
01093 if ((style(6:6)=='-')) then
01094 my_line_type2='linespoints'
01095 else
01096 my_line_type2='points'
01097 end if
01098 end if
01099 my_line_type3='lines'
01100 if (present(style)) then
01101 if ((style(9:9)=='-')) then
01102 my_line_type3='linespoints'
01103 else
01104 my_line_type3='points'
01105 end if
01106 end if
01107 my_line_type4='lines'
01108 if (present(style)) then
01109 if ((style(12:12)=='-')) then
01110 my_line_type4='linespoints'
01111 else
01112 my_line_type4='points'
01113 end if
01114 end if
01115 if (present(linewidth)) then
01116 write ( my_linewidth,'(e9.3)') linewidth
01117 else
01118 my_linewidth=trim(default_linewidth)
01119 end if
01120 if (present(color1)) then
01121 my_color1='"'//trim(color1)//'"'
01122 else
01123 my_color1='"'//trim(default_color1)//'"'
01124 end if
01125 if (present(color2)) then
01126 my_color2='"'//trim(color2)//'"'
01127 else
01128 my_color2='"'//trim(default_color2)//'"'
01129 end if
01130 if (present(color3)) then
01131 my_color3='"'//trim(color3)//'"'
01132 else
01133 my_color3='"'//trim(default_color3)//'"'
01134 end if
01135 if (present(color4)) then
01136 my_color4='"'//trim(color4)//'"'
01137 else
01138 my_color4='"'//trim(default_color4)//'"'
01139 end if
01140
01141 my_persist='persist '
01142 if (present(persist).and.(persist=='no')) my_persist=' '
01143 if (present(terminal)) then
01144 write ( file_unit, '(a)' ) 'set terminal '// trim(output_terminal(terminal))
01145 if (present(filename)) then
01146 write ( file_unit, '(a)' ) 'set output "'// trim(filename) //'"'
01147 else
01148 write ( file_unit, '(a)' ) 'set output "'//my_date_and_time()//'"'
01149 end if
01150 else
01151 write ( file_unit, '(a)' ) 'set terminal ' // trim(default_terminal) // ' ' &
01152 & //trim(my_persist) // ' title "Gnuplot"'
01153 end if
01154
01155 write ( file_unit, '(a)' ) 'unset key'
01156 if (present(polar).and.(polar=='yes')) then
01157 write (my_range,'(e15.7)') max(maxval(abs(y1)),maxval(abs(y2)),maxval(abs(y3)),maxval(abs(y4)))
01158 write ( file_unit, '(a)' ) 'set xrange [-'//trim(my_range)//':'//trim(my_range)//']'
01159 write ( file_unit, '(a)' ) 'set yrange [-'//trim(my_range)//':'//trim(my_range)//']'
01160 write ( file_unit, '(a)' ) 'set size square'
01161 write ( file_unit, '(a)' ) 'set polar'
01162 write ( file_unit, '(a)' ) 'set grid polar'
01163 else
01164 write ( file_unit, '(a)' ) 'set grid'
01165 end if
01166
01167 if (present(style)) then
01168 write ( file_unit, '(a,i2,a)' ) 'plot "' // trim (data_file_name) &
01169 &//'" using 1:2 with ' // trim(my_line_type1) // ' pointtype ' // &
01170 & style(1:2) // ' linecolor rgb ' // trim(my_color1) // ' linewidth '// trim(my_linewidth) //
01171 ',\' write ( file_unit, '(a,i2,a)' ) '
01172 "'// trim (data_file_name) & &//'" using 3:4 with ' // trim(my_line_type2) // ' pointtype
01173 ' & &// style(4:5) // ' linecolor rgb ' // trim(my_color2) // ' linewidth '// trim(my_linewidth) //',
01174 write ( file_unit, '(a,i2,a)' ) ' "'// trim (data_file_name) &
01175 &//'" using 5:6 with ' // trim(my_line_type3) // ' pointtype ' &
01176 &// style(7:8) // ' linecolor rgb ' // trim(my_color3) // ' linewidth '// trim(my_linewidth) //
01177 ',\' write ( file_unit, '(a,i2,a)' ) '
01178 "'// trim (data_file_name) & &//'" using 7:8 with ' // trim(my_line_type4) // ' pointtype
01179 ' & &// style(10:11) // ' linecolor rgb '// trim(my_color4)// ' linewidth
01180
01181 '// trim(my_linewidth) else write ( file_unit, '(a,i2,a)' ) 'plot
01182 "' // trim (data_file_name) & & //'" using 1:2 with ' // trim(my_line_type1) // ' linecolor rgb
01183 '& & // trim(my_color1) // ' linewidth '// trim(my_linewidth) // ',
01184 write ( file_unit, '(a,i2,a)' ) ' "'// trim (data_file_name) &
01185 & //'" using 3:4 with ' // trim(my_line_type2) // ' linecolor rgb '&
01186 & // trim(my_color2) // ' linewidth '// trim(my_linewidth) //
01187 ',\' write ( file_unit, '(a,i2,a)' ) '
01188 "'// trim (data_file_name) & & //'" using 5:6 with ' // trim(my_line_type3) // ' linecolor rgb
01189 '& & // trim(my_color3) // ' linewidth '// trim(my_linewidth) // ',
01190 write ( file_unit, '(a,i2,a)' ) ' "'// trim (data_file_name) &
01191 & //'" using 7:8 with ' // trim(my_line_type4) // ' linecolor rgb '&
01192 & // trim(my_color4) // ' linewidth '// trim(my_linewidth)
01193 end if
01194
01195 if (present(pause)) then
01196 if (pause<0.0) then
01197 write ( file_unit, '(a)' ) 'pause -1 "press RETURN to continue"'
01198 else
01199 write ( my_pause,'(e9.3)') pause
01200 write ( file_unit, '(a)' ) 'pause ' // trim(my_pause)
01201 end if
01202 else
01203 write ( file_unit, '(a)' ) 'pause 0'
01204 end if
01205
01206 write ( file_unit, '(a)' ) 'q'
01207 close ( unit = file_unit )
01208
01209 call run_gnuplot (command_file_name)
01210
01211 end subroutine plot_4
01212
01213
01214
01215 subroutine plot_3(x1,y1,x2,y2,x3,y3,style,pause,color1,color2,color3,terminal,filename,polar,persist,input,linewidth)
01216
01217
01218
01219 implicit none
01220 real(kind=8), intent(in) :: x1(:), y1(:), x2(:), y2(:), x3(:), y3(:)
01221 real(kind=4), optional :: pause,linewidth
01222 character(len=*),optional :: style, color1, color2, color3, terminal, filename, polar, persist, input
01223 integer :: i, ierror, ios, file_unit, Nx1, Nx2, Nx3, Nmax
01224 character(len=100) :: data_file_name, command_file_name, my_linewidth
01225 integer, parameter :: Nc=20
01226 character(len=Nc) :: my_line_type1, my_line_type2, my_line_type3, my_color1, my_color2,
01227 my_color3, my_range, my_pause, my_persist
01228
01229 if (present(input)) then
01230 data_file_name='data_file_'//input//'.txt'
01231 command_file_name='command_file_'//input//'.txt'
01232 else
01233 data_file_name='data_file.txt'
01234 command_file_name='command_file.txt'
01235 end if
01236
01237 Nx1=size(x1)
01238 Nx2=size(x2)
01239 Nx3=size(x3)
01240 if ((size(x1).ne.size(y1)).or.(size(x2).ne.size(y2)).or.(size(x3).ne.size(y3))) then
01241 print *,'subroutine plot ERROR: size(x) is not equal to size(y)'
01242 stop
01243 end if
01244 if (present(style).and.(len(style).ne.9)) then
01245 print *,'subroutine plot ERROR: argument "style" has wrong number of characters'
01246 stop
01247 end if
01248
01249 ierror=0
01250 call get_unit(file_unit)
01251 if (file_unit==0) then
01252 ierror=1
01253 print *,'write_vector_data - fatal error! Could not get a free FORTRAN unit.'
01254 stop
01255 end if
01256 open (unit=file_unit, file=data_file_name, status='replace', iostat=ios)
01257 if (ios/=0) then
01258 ierror=2
01259 print *,'write_vector_data - fatal error! Could not open the terminal data file.'
01260 stop
01261 end if
01262
01263
01264
01265 Nmax=max(Nx1,Nx2,Nx3)
01266 do i=1,Nmax
01267 write (file_unit,'(6E15.7)') x1(min(i,Nx1)), y1(min(i,Nx1)), x2(min(i,Nx2)), y2(min(i,Nx2)), &
01268 & x3(min(i,Nx3)), y3(min(i,Nx3))
01269 end do
01270
01271 close (unit=file_unit)
01272
01273 ierror = 0
01274 call get_unit(file_unit)
01275 if (file_unit==0) then
01276 ierror=1
01277 print *,'write_vector_data - fatal error! Could not get a free FORTRAN unit.'
01278 stop
01279 end if
01280 open (unit=file_unit, file=command_file_name, status='replace', iostat=ios)
01281 if (ios/=0) then
01282 ierror=2
01283 print *,'write_vector_data - fatal error! Could not open the terminal command file.'
01284 stop
01285 end if
01286
01287
01288
01289 my_line_type1='lines'
01290 if (present(style)) then
01291 if ((style(3:3)=='-')) then
01292 my_line_type1='linespoints'
01293 else
01294 my_line_type1='points'
01295 end if
01296 end if
01297 my_line_type2='lines'
01298 if (present(style)) then
01299 if ((style(6:6)=='-')) then
01300 my_line_type2='linespoints'
01301 else
01302 my_line_type2='points'
01303 end if
01304 end if
01305 my_line_type3='lines'
01306 if (present(style)) then
01307 if ((style(9:9)=='-')) then
01308 my_line_type3='linespoints'
01309 else
01310 my_line_type3='points'
01311 end if
01312 end if
01313 if (present(linewidth)) then
01314 write ( my_linewidth,'(e9.3)') linewidth
01315 else
01316 my_linewidth=trim(default_linewidth)
01317 end if
01318 if (present(color1)) then
01319 my_color1='"'//trim(color1)//'"'
01320 else
01321 my_color1='"'//trim(default_color1)//'"'
01322 end if
01323 if (present(color2)) then
01324 my_color2='"'//trim(color2)//'"'
01325 else
01326 my_color2='"'//trim(default_color2)//'"'
01327 end if
01328 if (present(color3)) then
01329 my_color3='"'//trim(color3)//'"'
01330 else
01331 my_color3='"'//trim(default_color3)//'"'
01332 end if
01333
01334 my_persist='persist '
01335 if (present(persist).and.(persist=='no')) my_persist=' '
01336 if (present(terminal)) then
01337 write ( file_unit, '(a)' ) 'set terminal '// trim(output_terminal(terminal))
01338 if (present(filename)) then
01339 write ( file_unit, '(a)' ) 'set output "'// trim(filename) //'"'
01340 else
01341 write ( file_unit, '(a)' ) 'set output "'//my_date_and_time()//'"'
01342 end if
01343 else
01344 write ( file_unit, '(a)' ) 'set terminal ' // trim(default_terminal) // ' ' &
01345 &//trim(my_persist) // ' title "Gnuplot"'
01346 end if
01347
01348
01349 write ( file_unit, '(a)' ) 'unset key'
01350 if (present(polar).and.(polar=='yes')) then
01351 write (my_range,'(e15.7)') max(maxval(abs(y1)),maxval(abs(y2)),maxval(abs(y3)))
01352 write ( file_unit, '(a)' ) 'set xrange [-'//trim(my_range)//':'//trim(my_range)//']'
01353 write ( file_unit, '(a)' ) 'set yrange [-'//trim(my_range)//':'//trim(my_range)//']'
01354 write ( file_unit, '(a)' ) 'set size square'
01355 write ( file_unit, '(a)' ) 'set polar'
01356 write ( file_unit, '(a)' ) 'set grid polar'
01357 else
01358 write ( file_unit, '(a)' ) 'set grid'
01359 end if
01360
01361 if (present(style)) then
01362 write ( file_unit, '(a,i2,a)' ) 'plot "' // trim (data_file_name) &
01363 &//'" using 1:2 with ' // trim(my_line_type1) // ' pointtype ' // &
01364 & style(1:2) // ' linecolor rgb ' // trim(my_color1) // ' linewidth '// trim(my_linewidth) //
01365 ',\' write ( file_unit, '(a,i2,a)' ) '
01366 "'// trim (data_file_name) & &//'" using 3:4 with ' // trim(my_line_type2) // ' pointtype
01367 ' & &// style(4:5) // ' linecolor rgb ' // trim(my_color2) // ' linewidth '// trim(my_linewidth) //',
01368 write ( file_unit, '(a,i2,a)' ) ' "'// trim (data_file_name) &
01369 &//'" using 5:6 with ' // trim(my_line_type3) // ' pointtype ' &
01370 &// style(7:8) // ' linecolor rgb ' // trim(my_color3) // ' linewidth '// trim(my_linewidth)
01371 else
01372 write ( file_unit, '(a,i2,a)' ) 'plot "' // trim (data_file_name) &
01373 & //'" using 1:2 with ' // trim(my_line_type1) // ' linecolor rgb '&
01374 & // trim(my_color1) // ' linewidth '// trim(my_linewidth) //
01375 ',\' write ( file_unit, '(a,i2,a)' ) '
01376 "'// trim (data_file_name) & & //'" using 3:4 with ' // trim(my_line_type2) // ' linecolor rgb
01377 '& & // trim(my_color2) // ' linewidth '// trim(my_linewidth) // ',
01378 write ( file_unit, '(a,i2,a)' ) ' "'// trim (data_file_name) &
01379 & //'" using 5:6 with ' // trim(my_line_type3) // ' linecolor rgb '&
01380 & // trim(my_color3) // ' linewidth '// trim(my_linewidth)
01381 end if
01382
01383 if (present(pause)) then
01384 if (pause<0.0) then
01385 write ( file_unit, '(a)' ) 'pause -1 "press RETURN to continue"'
01386 else
01387 write ( my_pause,'(e9.3)') pause
01388 write ( file_unit, '(a)' ) 'pause ' // trim(my_pause)
01389 end if
01390 else
01391 write ( file_unit, '(a)' ) 'pause 0'
01392 end if
01393
01394 write ( file_unit, '(a)' ) 'q'
01395 close ( unit = file_unit )
01396
01397 call run_gnuplot (command_file_name)
01398
01399 end subroutine plot_3
01400
01401
01402
01403 subroutine plot_2(x1,y1,x2,y2,style,pause,color1,color2,terminal,filename,polar,persist,input,linewidth)
01404
01405
01406
01407 implicit none
01408 real(kind=8), intent(in) :: x1(:), y1(:), x2(:), y2(:)
01409 real(kind=4), optional :: pause,linewidth
01410 character(len=*),optional :: style, color1, color2, terminal, filename, polar, persist, input
01411 integer :: i, ierror, ios, file_unit, Nx1, Nx2, Nmax
01412 character(len=100) :: data_file_name, command_file_name, my_linewidth
01413 integer, parameter :: Nc=20
01414 character(len=Nc) :: my_line_type1, my_line_type2, my_color1, my_color2, my_range, my_pause, my_persist
01415
01416 if (present(input)) then
01417 data_file_name='data_file_'//input//'.txt'
01418 command_file_name='command_file_'//input//'.txt'
01419 else
01420 data_file_name='data_file.txt'
01421 command_file_name='command_file.txt'
01422 end if
01423
01424 Nx1=size(x1)
01425 Nx2=size(x2)
01426 if ((size(x1).ne.size(y1)).or.(size(x2).ne.size(y2))) then
01427 print *,'subroutine plot ERROR: size(x) is not equal to size(y)'
01428 stop
01429 end if
01430 if (present(style).and.(len(style).ne.6)) then
01431 print *,'subroutine plot ERROR: argument "style" has wrong number of characters'
01432 stop
01433 end if
01434
01435 ierror=0
01436 call get_unit(file_unit)
01437 if (file_unit==0) then
01438 ierror=1
01439 print *,'write_vector_data - fatal error! Could not get a free FORTRAN unit.'
01440 stop
01441 end if
01442 open (unit=file_unit, file=data_file_name, status='replace', iostat=ios)
01443 if (ios/=0) then
01444 ierror=2
01445 print *,'write_vector_data - fatal error! Could not open the terminal data file.'
01446 stop
01447 end if
01448
01449
01450
01451 Nmax=max(Nx1,Nx2)
01452 do i=1,Nmax
01453 write (file_unit,'(4E15.7)') x1(min(i,Nx1)), y1(min(i,Nx1)), x2(min(i,Nx2)), y2(min(i,Nx2))
01454 end do
01455
01456 close (unit=file_unit)
01457
01458 ierror = 0
01459 call get_unit(file_unit)
01460 if (file_unit==0) then
01461 ierror=1
01462 print *,'write_vector_data - fatal error! Could not get a free FORTRAN unit.'
01463 stop
01464 end if
01465 open (unit=file_unit, file=command_file_name, status='replace', iostat=ios)
01466 if (ios/=0) then
01467 ierror=2
01468 print *,'write_vector_data - fatal error! Could not open the terminal command file.'
01469 stop
01470 end if
01471
01472
01473
01474 my_line_type1='lines'
01475 if (present(style)) then
01476 if ((style(3:3)=='-')) then
01477 my_line_type1='linespoints'
01478 else
01479 my_line_type1='points'
01480 end if
01481 end if
01482 my_line_type2='lines'
01483 if (present(style)) then
01484 if ((style(6:6)=='-')) then
01485 my_line_type2='linespoints'
01486 else
01487 my_line_type2='points'
01488 end if
01489 end if
01490 if (present(linewidth)) then
01491 write ( my_linewidth,'(e9.3)') linewidth
01492 else
01493 my_linewidth=trim(default_linewidth)
01494 end if
01495 if (present(color1)) then
01496 my_color1='"'//trim(color1)//'"'
01497 else
01498 my_color1='"'//trim(default_color1)//'"'
01499 end if
01500 if (present(color2)) then
01501 my_color2='"'//trim(color2)//'"'
01502 else
01503 my_color2='"'//trim(default_color2)//'"'
01504 end if
01505
01506 my_persist='persist '
01507 if (present(persist).and.(persist=='no')) my_persist=' '
01508 if (present(terminal)) then
01509 write ( file_unit, '(a)' ) 'set terminal '// trim(output_terminal(terminal))
01510 if (present(filename)) then
01511 write ( file_unit, '(a)' ) 'set output "'// trim(filename) //'"'
01512 else
01513 write ( file_unit, '(a)' ) 'set output "'//my_date_and_time()//'"'
01514 end if
01515 else
01516 write ( file_unit, '(a)' ) 'set terminal ' // trim(default_terminal) // ' ' &
01517 & //trim(my_persist) // ' title "Gnuplot"'
01518 end if
01519
01520
01521 write ( file_unit, '(a)' ) 'unset key'
01522 write ( file_unit, '(a)' ) 'unset key'
01523 if (present(polar).and.(polar=='yes')) then
01524 write (my_range,'(e15.7)') max(maxval(abs(y1)),maxval(abs(y2)))
01525 write ( file_unit, '(a)' ) 'set xrange [-'//trim(my_range)//':'//trim(my_range)//']'
01526 write ( file_unit, '(a)' ) 'set yrange [-'//trim(my_range)//':'//trim(my_range)//']'
01527 write ( file_unit, '(a)' ) 'set size square'
01528 write ( file_unit, '(a)' ) 'set polar'
01529 write ( file_unit, '(a)' ) 'set grid polar'
01530 else
01531 write ( file_unit, '(a)' ) 'set grid'
01532 end if
01533
01534 if (present(style)) then
01535 write ( file_unit, '(a,i2,a)' ) 'plot "' // trim (data_file_name) &
01536 &//'" using 1:2 with ' // trim(my_line_type1) // ' pointtype ' // &
01537 & style(1:2) // ' linecolor rgb ' // trim(my_color1) // ' linewidth '// trim(my_linewidth) //
01538 ',\' write ( file_unit, '(a,i2,a)' ) '
01539 "'// trim (data_file_name) & &//'" using 3:4 with ' // trim(my_line_type2) // ' pointtype
01540 ' & &// style(4:5) // ' linecolor rgb ' // trim(my_color2) // ' linewidth
01541
01542 '// trim(my_linewidth) else write ( file_unit, '(a,i2,a)' ) 'plot
01543 "' // trim (data_file_name) & & //'" using 1:2 with ' // trim(my_line_type1) // ' linecolor rgb
01544 '& & // trim(my_color1) // ' linewidth '// trim(my_linewidth) // ',
01545 write ( file_unit, '(a,i2,a)' ) ' "'// trim (data_file_name) &
01546 & //'" using 3:4 with ' // trim(my_line_type2) // ' linecolor rgb '&
01547 & // trim(my_color2) // ' linewidth '// trim(my_linewidth)
01548 end if
01549
01550 if (present(pause)) then
01551 if (pause<0.0) then
01552 write ( file_unit, '(a)' ) 'pause -1 "press RETURN to continue"'
01553 else
01554 write ( my_pause,'(e9.3)') pause
01555 write ( file_unit, '(a)' ) 'pause ' // trim(my_pause)
01556 end if
01557 else
01558 write ( file_unit, '(a)' ) 'pause 0'
01559 end if
01560
01561 write ( file_unit, '(a)' ) 'q'
01562 close ( unit = file_unit )
01563
01564 call run_gnuplot (command_file_name)
01565
01566 end subroutine plot_2
01567
01568
01569
01570 subroutine plot_1(x1,y1,style,pause,color1,terminal,filename,polar,persist,input,linewidth)
01571
01572
01573
01574 implicit none
01575 real(kind=8), intent(in) :: x1(:), y1(:)
01576 real(kind=4), optional :: pause,linewidth
01577 character(len=*),optional :: style, color1, terminal, filename, polar, persist, input
01578 integer :: i, ierror, ios, file_unit, Nx1
01579 character(len=100) :: data_file_name, command_file_name, my_linewidth
01580 integer, parameter :: Nc=20
01581 character(len=Nc) :: my_line_type1, my_color1, my_range, my_pause, my_persist
01582
01583 if (present(input)) then
01584 data_file_name='data_file_'//input//'.txt'
01585 command_file_name='command_file_'//input//'.txt'
01586 else
01587 data_file_name='data_file.txt'
01588 command_file_name='command_file.txt'
01589 end if
01590
01591 Nx1=size(x1)
01592 if ((size(x1).ne.size(y1))) then
01593 print *,'subroutine plot ERROR: size(x) is not equal to size(y)'
01594 stop
01595 end if
01596 if (present(style).and.(len(style).ne.3)) then
01597 print *,'subroutine plot ERROR: argument "style" has wrong number of characters'
01598 stop
01599 end if
01600
01601 ierror=0
01602 call get_unit(file_unit)
01603 if (file_unit==0) then
01604 ierror=1
01605 print *,'write_vector_data - fatal error! Could not get a free FORTRAN unit.'
01606 stop
01607 end if
01608 open (unit=file_unit, file=data_file_name, status='replace', iostat=ios)
01609 if (ios/=0) then
01610 ierror=2
01611 print *,'write_vector_data - fatal error! Could not open the terminal data file.'
01612 stop
01613 end if
01614
01615
01616
01617 do i=1,Nx1
01618 write (file_unit,'(2E15.7)') x1(i), y1(i)
01619 end do
01620
01621 close (unit=file_unit)
01622
01623 ierror = 0
01624 call get_unit(file_unit)
01625 if (file_unit==0) then
01626 ierror=1
01627 print *,'write_vector_data - fatal error! Could not get a free FORTRAN unit.'
01628 stop
01629 end if
01630 open (unit=file_unit, file=command_file_name, status='replace', iostat=ios)
01631 if (ios/=0) then
01632 ierror=2
01633 print *,'write_vector_data - fatal error! Could not open the terminal command file.'
01634 stop
01635 end if
01636
01637
01638
01639 my_line_type1='lines'
01640 if (present(style)) then
01641 if ((style(3:3)=='-')) then
01642 my_line_type1='linespoints'
01643 else
01644 my_line_type1='points'
01645 end if
01646 end if
01647 if (present(linewidth)) then
01648 write ( my_linewidth,'(e9.3)') linewidth
01649 else
01650 my_linewidth=trim(default_linewidth)
01651 end if
01652 if (present(color1)) then
01653 my_color1='"'//trim(color1)//'"'
01654 else
01655 my_color1='"'//trim(default_color1)//'"'
01656 end if
01657
01658 my_persist='persist '
01659 if (present(persist).and.(persist=='no')) my_persist=' '
01660 if (present(terminal)) then
01661 write ( file_unit, '(a)' ) 'set terminal '// trim(output_terminal(terminal))
01662 if (present(filename)) then
01663 write ( file_unit, '(a)' ) 'set output "'// trim(filename) //'"'
01664 else
01665 write ( file_unit, '(a)' ) 'set output "'//my_date_and_time()//'"'
01666 end if
01667 else
01668 write ( file_unit, '(a)' ) 'set terminal ' // trim(default_terminal) // ' ' &
01669 & //trim(my_persist) //' title "Gnuplot"'
01670 end if
01671
01672 write ( file_unit, '(a)' ) 'unset key'
01673 if (present(polar).and.(polar=='yes')) then
01674 write (my_range,'(e15.7)') maxval(abs(y1))
01675 write ( file_unit, '(a)' ) 'set xrange [-'//trim(my_range)//':'//trim(my_range)//']'
01676 write ( file_unit, '(a)' ) 'set yrange [-'//trim(my_range)//':'//trim(my_range)//']'
01677 write ( file_unit, '(a)' ) 'set size square'
01678 write ( file_unit, '(a)' ) 'set polar'
01679 write ( file_unit, '(a)' ) 'set grid polar'
01680 else
01681 write ( file_unit, '(a)' ) 'set grid'
01682 end if
01683
01684 if (present(style)) then
01685 write ( file_unit, '(a,i2,a)' ) 'plot "' // trim (data_file_name) &
01686 &//'" using 1:2 with ' // trim(my_line_type1) // ' pointtype ' // &
01687 & style(1:2) // ' linecolor rgb ' // trim(my_color1) // ' linewidth '// trim(my_linewidth)
01688 else
01689 write ( file_unit, '(a,i2,a)' ) 'plot "' // trim (data_file_name) &
01690 & //'" using 1:2 with ' // trim(my_line_type1) // ' linecolor rgb '&
01691 & // trim(my_color1) // ' linewidth '// trim(my_linewidth)
01692 end if
01693
01694 if (present(pause)) then
01695 if (pause<0.0) then
01696 write ( file_unit, '(a)' ) 'pause -1 "press RETURN to continue"'
01697 else
01698 write ( my_pause,'(e9.3)') pause
01699 write ( file_unit, '(a)' ) 'pause ' // trim(my_pause)
01700 end if
01701 else
01702 write ( file_unit, '(a)' ) 'pause 0'
01703 end if
01704
01705 write ( file_unit, '(a)' ) 'q'
01706 close ( unit = file_unit )
01707
01708 call run_gnuplot (command_file_name)
01709
01710 end subroutine plot_1
01711
01712
01713
01714 subroutine run_gnuplot(command_file_name)
01715
01716 implicit none
01717 character (len = 100) command
01718 character (len = *) command_file_name
01719 integer status
01720 integer system
01721
01722
01723
01724
01725 write (command, *) 'gnuplot ' // trim (command_file_name)
01726 status=system(trim(command))
01727 if (status.ne.0) then
01728 print *,'RUN_GNUPLOT - Fatal error!'
01729 stop
01730 end if
01731 return
01732
01733 end subroutine run_gnuplot
01734
01735
01736
01737 subroutine get_unit(iunit)
01738
01739 implicit none
01740 integer i
01741 integer ios
01742 integer iunit
01743 logical lopen
01744
01745 iunit=0
01746 do i=1,99
01747 if (i/= 5 .and. i/=6) then
01748 inquire (unit=i, opened=lopen, iostat=ios)
01749 if (ios==0) then
01750 if (.not.lopen) then
01751 iunit=i
01752 return
01753 end if
01754 end if
01755
01756 end if
01757 end do
01758 return
01759 end subroutine get_unit
01760
01761 end module gnufor2