00001 *DECK XSETUA 00002 SUBROUTINE XSETUA (IUNITA, N) 00003 C***BEGIN PROLOGUE XSETUA 00004 C***PURPOSE Set logical unit numbers (up to 5) to which error 00005 C messages are to be sent. 00006 C***LIBRARY SLATEC (XERROR) 00007 C***CATEGORY R3B 00008 C***TYPE ALL (XSETUA-A) 00009 C***KEYWORDS ERROR, XERROR 00010 C***AUTHOR Jones, R. E., (SNLA) 00011 C***DESCRIPTION 00012 C 00013 C Abstract 00014 C XSETUA may be called to declare a list of up to five 00015 C logical units, each of which is to receive a copy of 00016 C each error message processed by this package. 00017 C The purpose of XSETUA is to allow simultaneous printing 00018 C of each error message on, say, a main output file, 00019 C an interactive terminal, and other files such as graphics 00020 C communication files. 00021 C 00022 C Description of Parameters 00023 C --Input-- 00024 C IUNIT - an array of up to five unit numbers. 00025 C Normally these numbers should all be different 00026 C (but duplicates are not prohibited.) 00027 C N - the number of unit numbers provided in IUNIT 00028 C must have 1 .LE. N .LE. 5. 00029 C 00030 C***REFERENCES R. E. Jones and D. K. Kahaner, XERROR, the SLATEC 00031 C Error-handling Package, SAND82-0800, Sandia 00032 C Laboratories, 1982. 00033 C***ROUTINES CALLED J4SAVE, XERMSG 00034 C***REVISION HISTORY (YYMMDD) 00035 C 790801 DATE WRITTEN 00036 C 861211 REVISION DATE from Version 3.2 00037 C 891214 Prologue converted to Version 4.0 format. (BAB) 00038 C 900510 Change call to XERRWV to XERMSG. (RWC) 00039 C 920501 Reformatted the REFERENCES section. (WRB) 00040 C***END PROLOGUE XSETUA 00041 DIMENSION IUNITA(5) 00042 CHARACTER *8 XERN1 00043 C***FIRST EXECUTABLE STATEMENT XSETUA 00044 C 00045 IF (N.LT.1 .OR. N.GT.5) THEN 00046 WRITE (XERN1, '(I8)') N 00047 CALL XERMSG ('SLATEC', 'XSETUA', 00048 * 'INVALID NUMBER OF UNITS, N = ' // XERN1, 1, 2) 00049 RETURN 00050 ENDIF 00051 C 00052 DO 10 I=1,N 00053 INDEX = I+4 00054 IF (I.EQ.1) INDEX = 3 00055 JUNK = J4SAVE(INDEX,IUNITA(I),.TRUE.) 00056 10 CONTINUE 00057 JUNK = J4SAVE(5,N,.TRUE.) 00058 RETURN 00059 END
1.7.1
