1c 2c $Id$ 3c 4 5#ifdef USE_SUBGROUPS 6 block data util_stdio_data 7 implicit none 8#include "stdio.fh" 9c 10 data luout /6/ 11 12 end 13#endif 14 block data initial_util_io_data 15 implicit none 16#include "util_io_data.fh" 17c 18 data io_on /.false./ 19 data io_unit /6/ 20 21 end 22 23 function util_get_io_unit(fn) 24 25 implicit none 26 integer fn 27 logical util_get_io_unit 28c 29 integer k 30 logical ostatus 31c 32 do k=80,90 33 INQUIRE(UNIT=k,OPENED=ostatus) 34 ostatus = .not.ostatus 35 if(ostatus) 36 > INQUIRE(UNIT=k,EXIST=ostatus) 37 if(ostatus) then 38 fn = k 39 util_get_io_unit = .true. 40 return 41 end if 42 end do 43 util_get_io_unit = .false. 44 return 45 end 46 47 subroutine util_print_xyz(un,nt,c,t) 48 implicit none 49 integer un 50 integer nt 51 double precision c(3,nt) 52 character*16 t(nt) 53 54 integer i 55 56 write(un,FMT=1) nt 57 58 do i=1,nt 59 write(un,FMT=2) 60 > t(i),c(1,i)*0.529177249d00, 61 > c(2,i)*0.529177249d00, 62 > c(3,i)*0.529177249d00 63 64 end do 651 FORMAT(1X,I9,/, " ") 662 FORMAT(1X,A5,6X,3(F12.6,4X)) 67 68 end 69 70 subroutine util_print_tagged_3d_array(un,nt,scale,c,t) 71 implicit none 72 integer un 73 integer nt 74 double precision c(3,nt) 75 character*16 t(nt) 76 double precision scale 77 78 integer i 79 80 do i=1,nt 81 write(un,FMT=2) 82 > i,t(i),c(1,i)*scale, 83 > c(2,i)*scale, 84 > c(3,i)*scale 85 86 end do 872 FORMAT(1X,I5,5X,A16,6X,3(F12.6,4X)) 88 89 end 90 91 subroutine util_message(buffer) 92 implicit none 93#include "stdio.fh" 94#include "global.fh" 95#include "util_io_data.fh" 96 character*(*) buffer 97 98 if(.not.io_on) return 99c 100 write(io_unit,*) buffer,ga_nodeid() 101 call util_flush(io_unit) 102 return 103 end 104 105 subroutine util_io_enable() 106 implicit none 107#include "stdio.fh" 108#include "util_io_data.fh" 109 io_on = .true. 110 return 111 end 112 113 subroutine util_io_disable() 114 implicit none 115#include "stdio.fh" 116#include "util_io_data.fh" 117 io_on = .false. 118 return 119 end 120 121