subroutine IVECPR(V, N, TEXT, LWIDTH, LUNIT ) c Copyright (c) 1996 California Institute of Technology, Pasadena, CA. c ALL RIGHTS RESERVED. c Based on Government Sponsored Research NAS7-03001. C>> 2000-12-01 IVECPR Krogh Removed unused parameter METXTF. C>> 1994-11-11 IVECPR Krogh Declared all vars. c>> 1994-10-20 IVECPR Krogh Added M77CON code. c>> 1992-05-03 IVECPR Krogh Convert to use MESSFT for Fortran text. c>> 1992-04-08 IVECPR Krogh Replaced dummy K with MACT in ?MESS call. c>> 1991-11-22 IVECPR F. Krogh Initial code c++I DEFAULT MACT1D=3, TAIL=", LUNIT" c++ DEFAULT MACT1D=5, TAIL=", LUNIT, NUMDIG" c++ REPLACE ", LUNIT " = TAIL c--I replaces "?": ?VECPR, ?MESS c c ***** Formal Arguments *********************************** c c V Vector to be output, V = V(I), I = 1, N c N Number of vector components. c TEXT a variable length character type that gives a message to print. c LWIDTH Line width in characters. If this or any of the following c parameter are < 0, then current defaults set in MESS are used. c LUNIT Logical unit number. (0 prints to the standard output.) c NUMDIG Number of significant digits to print (Not used for integer). c c ******************** Parameter for interfacing to MESS ************* c integer MEMLIN, MEMUNI, METDIG, MECONT, MERET, MACT1D parameter (MEMLIN =13) parameter (MEMUNI =15) parameter (METDIG =22) parameter (MECONT =50) parameter (MERET =51) c++ Substitute for MACT1D below parameter (MACT1D = 3) c integer N, LWIDTH, LUNIT character*(*) TEXT character*2 TTEXT(1) integer K, MACT(9), MACT1(MACT1D) c--I Next line special: I integer V(N) c++ Code for {I} is active integer MEIVEC parameter (MEIVEC=57) data MACT1 / MEIVEC, 0, MERET / MACT1(2) = max(N, 0) c++ Code for ~{I} is inactive C integer MEFVEC C parameter (MEFVEC=61) C data MACT1 / METDIG, 0, MEFVEC, 0, MERET / C MACT1(2) = max(0, NUMDIG) C MACT1(4) = max(N, 0) c++ End c K = 1 if (LWIDTH .gt. 20) then MACT(1) = -MEMLIN MACT(3) = MEMLIN MACT(4) = LWIDTH K = 5 end if if (LUNIT .ge. 0) then MACT(K) = -MEMUNI MACT(K+2) = MEMUNI MACT(K+3) = LUNIT K = K + 4 end if MACT(K) = MECONT if (K .gt. 1) call MESSFT(MACT, TEXT) c++ Code for {I} is active call MESS(MACT1, TTEXT, V) c++ Code for ~{I} is inactive C call IMESS(MACT1, TTEXT, MACT, V) c++ End if (MACT(1) .lt. 0) then c Restore MESS parameters to original state MACT(1) = - MACT(1) MACT(3) = MERET if (MACT(5) .lt. 0) then MACT(3) = MEMUNI MACT(4) = MACT(6) MACT(5) = MERET end if call MESS(MACT, TTEXT, MACT) end if return end