Oasis3 4.0.2
|
00001 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00002 ! 00003 ! This module is a dynamic I/O unit manager. It keeps track of 00004 ! which units are in use and reserves units for stdin, stdout, and 00005 ! stderr. 00006 ! 00007 !----------------------------------------------------------------------- 00008 ! 00009 ! CVS:$Id: iounits.f 2826 2010-12-10 11:14:21Z valcke $ 00010 ! 00011 ! Copyright (c) 1997, 1998 the Regents of the University of 00012 ! California. 00013 ! 00014 ! This software and ancillary information (herein called software) 00015 ! called SCRIP is made available under the terms described here. 00016 ! The software has been approved for release with associated 00017 ! LA-CC Number 98-45. 00018 ! 00019 ! Unless otherwise indicated, this software has been authored 00020 ! by an employee or employees of the University of California, 00021 ! operator of the Los Alamos National Laboratory under Contract 00022 ! No. W-7405-ENG-36 with the U.S. Department of Energy. The U.S. 00023 ! Government has rights to use, reproduce, and distribute this 00024 ! software. The public may copy and use this software without 00025 ! charge, provided that this Notice and any statement of authorship 00026 ! are reproduced on all copies. Neither the Government nor the 00027 ! University makes any warranty, express or implied, or assumes 00028 ! any liability or responsibility for the use of this software. 00029 ! 00030 ! If software is modified to produce derivative works, such modified 00031 ! software should be clearly marked, so as not to confuse it with 00032 ! the version available from Los Alamos National Laboratory. 00033 ! 00034 !*********************************************************************** 00035 00036 module iounits 00037 00038 !----------------------------------------------------------------------- 00039 00040 use kinds_mod ! defines data types 00041 USE mod_unit 00042 USE mod_printing 00043 00044 implicit none 00045 00046 !----------------------------------------------------------------------- 00047 00048 logical (kind=log_kind), dimension(99), save :: 00049 & unit_free ! flags to determine whether unit is free for use 00050 00051 integer (kind=int_kind), parameter :: 00052 & stdin = 5, ! reserves unit for standard input 00053 & stdout = 6, ! reserves unit for standard output 00054 & stderr = 6 ! reserves unit for standard error 00055 00056 !*********************************************************************** 00057 00058 contains 00059 00060 !*********************************************************************** 00061 00062 subroutine get_unit(iunit) 00063 00064 !----------------------------------------------------------------------- 00065 ! 00066 ! This routine returns the next available I/O unit number. 00067 ! 00068 !----------------------------------------------------------------------- 00069 00070 !----------------------------------------------------------------------- 00071 ! 00072 ! output variables 00073 ! 00074 !----------------------------------------------------------------------- 00075 00076 integer (kind=int_kind), intent(out) :: 00077 & iunit ! next free I/O unit 00078 00079 !----------------------------------------------------------------------- 00080 ! 00081 ! local variables 00082 ! 00083 !----------------------------------------------------------------------- 00084 00085 integer (kind=int_kind) :: n 00086 00087 logical (kind=log_kind), save :: first_call = .true. 00088 00089 !----------------------------------------------------------------------- 00090 ! 00091 ! if this is the first call, reserve stdout, stdin and stderr 00092 ! 00093 !----------------------------------------------------------------------- 00094 ! 00095 IF (nlogprt .GE. 2) THEN 00096 WRITE (UNIT = nulou,FMT = *)' ' 00097 WRITE (UNIT = nulou,FMT = *)'Entering routine get_unit' 00098 WRITE (UNIT = nulou,FMT = *)' ' 00099 CALL FLUSH(nulou) 00100 ENDIF 00101 ! 00102 if (first_call) then 00103 unit_free = .true. 00104 unit_free(stdin) = .false. 00105 unit_free(stdout) = .false. 00106 unit_free(stderr) = .false. 00107 first_call = .false. 00108 endif 00109 00110 !----------------------------------------------------------------------- 00111 ! 00112 ! search for next available unit 00113 ! 00114 !----------------------------------------------------------------------- 00115 00116 srch_unit: do n=1,99 00117 if (unit_free(n)) then 00118 iunit = n 00119 unit_free(n) = .false. 00120 exit srch_unit 00121 endif 00122 end do srch_unit 00123 ! 00124 IF (nlogprt .GE. 2) THEN 00125 WRITE (UNIT = nulou,FMT = *)' ' 00126 WRITE (UNIT = nulou,FMT = *)'Leaving routine get_unit' 00127 WRITE (UNIT = nulou,FMT = *)' ' 00128 CALL FLUSH(nulou) 00129 ENDIF 00130 ! 00131 !----------------------------------------------------------------------- 00132 00133 end subroutine get_unit 00134 00135 !*********************************************************************** 00136 00137 subroutine release_unit(iunit) 00138 00139 !----------------------------------------------------------------------- 00140 ! 00141 ! This routine releases the specified unit and closes the file. 00142 ! 00143 !----------------------------------------------------------------------- 00144 !----------------------------------------------------------------------- 00145 ! 00146 ! input variables 00147 ! 00148 !----------------------------------------------------------------------- 00149 00150 integer (kind=int_kind), intent(in) :: 00151 & iunit ! I/O unit to release 00152 00153 !----------------------------------------------------------------------- 00154 ! 00155 ! closes I/O unit and declares it free 00156 ! 00157 !----------------------------------------------------------------------- 00158 ! 00159 IF (nlogprt .GE. 2) THEN 00160 WRITE (UNIT = nulou,FMT = *)' ' 00161 WRITE (UNIT = nulou,FMT = *)'Entering routine release_unit' 00162 WRITE (UNIT = nulou,FMT = *)' ' 00163 CALL FLUSH(nulou) 00164 ENDIF 00165 ! 00166 unit_free(iunit) = .true. 00167 close(iunit) 00168 00169 !----------------------------------------------------------------------- 00170 ! 00171 IF (nlogprt .GE. 2) THEN 00172 WRITE (UNIT = nulou,FMT = *)' ' 00173 WRITE (UNIT = nulou,FMT = *)'Leaving routine release_unit' 00174 WRITE (UNIT = nulou,FMT = *)' ' 00175 CALL FLUSH(nulou) 00176 ENDIF 00177 ! 00178 end subroutine release_unit 00179 00180 !*********************************************************************** 00181 00182 end module iounits 00183 00184 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!