source: CPL/oasis3-mct/branches/OASIS3-MCT_5.0_branch/lib/scrip/src/iounits.f90 @ 6331

Last change on this file since 6331 was 6331, checked in by aclsce, 17 months ago

Moved oasis-mct_5.0 in oasis3-mct/branches directory.

File size: 6.0 KB
Line 
1!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2!
3!     This module is a dynamic I/O unit manager.  It keeps track of
4!     which units are in use and reserves units for stdin, stdout, and
5!     stderr.
6!
7!-----------------------------------------------------------------------
8!
9!     CVS:$Id: iounits.f 2826 2010-12-10 11:14:21Z valcke $
10!
11!     Copyright (c) 1997, 1998 the Regents of the University of
12!       California.
13!
14!     This software and ancillary information (herein called software)
15!     called SCRIP is made available under the terms described here. 
16!     The software has been approved for release with associated
17!     LA-CC Number 98-45.
18!
19!     Unless otherwise indicated, this software has been authored
20!     by an employee or employees of the University of California,
21!     operator of the Los Alamos National Laboratory under Contract
22!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
23!     Government has rights to use, reproduce, and distribute this
24!     software.  The public may copy and use this software without
25!     charge, provided that this Notice and any statement of authorship
26!     are reproduced on all copies.  Neither the Government nor the
27!     University makes any warranty, express or implied, or assumes
28!     any liability or responsibility for the use of this software.
29!
30!     If software is modified to produce derivative works, such modified
31!     software should be clearly marked, so as not to confuse it with
32!     the version available from Los Alamos National Laboratory.
33!
34!***********************************************************************
35
36      module iounits
37
38!-----------------------------------------------------------------------
39
40      use kinds_mod   ! defines data types
41      USE mod_oasis_flush
42
43      implicit none
44
45!-----------------------------------------------------------------------
46
47      logical (kind=log_kind), dimension(99), save :: unit_free   ! flags to determine whether unit is free for use
48
49      integer (kind=int_kind), parameter :: stdin  = 5,  & ! reserves unit for standard input
50                                            stdout = 6,  & ! reserves unit for standard output
51                                            stderr = 6  ! reserves unit for standard error
52
53!***********************************************************************
54
55      contains
56
57!***********************************************************************
58
59      subroutine get_unit(iunit)
60
61!-----------------------------------------------------------------------
62!
63!     This routine returns the next available I/O unit number.
64!
65!-----------------------------------------------------------------------
66
67!-----------------------------------------------------------------------
68!
69!     output variables
70!
71!-----------------------------------------------------------------------
72
73      integer (kind=int_kind), intent(out) :: iunit   ! next free I/O unit
74
75!-----------------------------------------------------------------------
76!
77!     local variables
78!
79!-----------------------------------------------------------------------
80
81      integer (kind=int_kind) :: n
82
83      logical (kind=log_kind), save :: first_call = .true.
84
85!-----------------------------------------------------------------------
86!
87!     if this is the first call, reserve stdout, stdin and stderr
88!
89!-----------------------------------------------------------------------
90!
91      IF (nlogprt .GE. 2) THEN
92         WRITE (UNIT = nulou,FMT = *)' '
93         WRITE (UNIT = nulou,FMT = *)'Entering routine get_unit'
94         WRITE (UNIT = nulou,FMT = *)' '
95         CALL OASIS_FLUSH_SCRIP(nulou)
96      ENDIF
97!
98      if (first_call) then
99        unit_free = .true.
100        unit_free(stdin)  = .false.
101        unit_free(stdout) = .false.
102        unit_free(stderr) = .false.
103        first_call = .false.
104      endif
105
106!-----------------------------------------------------------------------
107!
108!     search for next available unit
109!
110!-----------------------------------------------------------------------
111
112      srch_unit: do n=1,99
113        if (unit_free(n)) then
114          iunit = n
115          unit_free(n) = .false.
116          exit srch_unit
117        endif
118      end do srch_unit
119!
120      IF (nlogprt .GE. 2) THEN
121         WRITE (UNIT = nulou,FMT = *)' '
122         WRITE (UNIT = nulou,FMT = *)'Leaving routine get_unit'
123         WRITE (UNIT = nulou,FMT = *)' '
124         CALL OASIS_FLUSH_SCRIP(nulou)
125      ENDIF
126!
127!-----------------------------------------------------------------------
128
129      end subroutine get_unit
130
131!***********************************************************************
132
133      subroutine release_unit(iunit)
134
135!-----------------------------------------------------------------------
136!
137!     This routine releases the specified unit and closes the file.
138!
139!-----------------------------------------------------------------------
140!-----------------------------------------------------------------------
141!
142!     input variables
143!
144!-----------------------------------------------------------------------
145
146      integer (kind=int_kind), intent(in) :: iunit   ! I/O unit to release
147
148!-----------------------------------------------------------------------
149!
150!     closes I/O unit and declares it free
151!
152!-----------------------------------------------------------------------
153!
154      IF (nlogprt .GE. 2) THEN
155         WRITE (UNIT = nulou,FMT = *)' '
156         WRITE (UNIT = nulou,FMT = *)'Entering routine release_unit'
157         WRITE (UNIT = nulou,FMT = *)' '
158         CALL OASIS_FLUSH_SCRIP(nulou)
159      ENDIF
160!
161      unit_free(iunit) = .true.
162      close(iunit)
163
164!-----------------------------------------------------------------------
165!
166      IF (nlogprt .GE. 2) THEN
167         WRITE (UNIT = nulou,FMT = *)' '
168         WRITE (UNIT = nulou,FMT = *)'Leaving routine release_unit'
169         WRITE (UNIT = nulou,FMT = *)' '
170         CALL OASIS_FLUSH_SCRIP(nulou)
171      ENDIF
172!
173      end subroutine release_unit
174
175!***********************************************************************
176
177      end module iounits
178
179!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Note: See TracBrowser for help on using the repository browser.