1c 2c $Id$ 3c 4 5!******************************************************* 6! 7! Name : 8! 9! Purpose : 10! 11! Created : 12!******************************************************* 13 subroutine get_io_unit(fp) 14 implicit none 15 integer fp 16 17 !*** local variables *** 18 integer min_io_unit,max_io_unit 19 parameter(min_io_unit = 20,max_io_unit = 100) 20 21 logical open_status,exist_status 22 integer i,ierr 23 24 DO i=min_io_unit,max_io_unit 25 26 inquire(UNIT=i, 27 > OPENED = open_status, 28 > EXIST = exist_status, 29 > IOSTAT= ierr) 30 if(.not. open_status .and. 31 > exist_status .and. ierr.eq.0) then 32 fp = i 33 return 34 end if 35 36 end do 37 38 call errquit("cannot get free file unit",0,0) 39 40 return 41 end 42!******************************************************* 43! 44! Name : 45! 46! Purpose : 47! 48! Created : 49!******************************************************* 50 function assert_file(filename) 51 implicit none 52 character*(*) filename 53 54 logical assert_file !result 55 56 !*** local variables *** 57 logical file_exist 58 59 inquire(FILE=filename, EXIST=file_exist) 60 assert_file = file_exist 61 return 62 end 63 64!******************************************************* 65! 66! Name : 67! 68! Purpose : 69! 70! Created : 71!******************************************************* 72 subroutine open_file(FileName,mode,fp) 73 implicit none 74 character*(*) FileName 75 character*(*) mode 76 integer fp 77 78* !**** local variables **** 79 integer l,ierr 80 character*20 action, status,position 81 character*255 junk 82 83 l = index(mode,' ') -1 84 if (l.lt.1) l = 1 85 if (mode(1:l).eq.'r') then 86 action = 'READ' 87 status = 'OLD' 88 position = 'REWIND' 89 else if (mode(1:l).eq.'w') then 90 action = 'WRITE' 91 status = 'REPLACE' 92 position = "REWIND" 93 else if (mode(1:l).eq.'w+') then 94 action = 'WRITE' 95 status = 'OLD' 96 position = "APPEND" 97 else 98 junk = "unknown parameter in open_file, "//mode(1:l) 99 call errquit(junk,0,0) 100 end if 101 102 call get_io_unit(fp) 103 104 l = index(FileName,' ') -1 105 open(UNIT=fp,FILE=FileName(1:l), 106 > STATUS=status, 107 > FORM='formatted', 108 > IOSTAT=ierr) 109 110 if (ierr.ne.0) then 111 junk = " opening "//FileName 112 call errquit(junk,0,0) 113 end if 114 115 return 116 end !SUBROUTINE open_file 117 118