/*Translated by FOR_C, v3.4.2 (-), on 07/09/115 at 08:31:22 */ /*FOR_C Options SET: ftn=u io=c no=p op=aimnv s=dbov str=l x=f - prototypes */ #include #include "fcrt.h" #include "svecpr.h" #include #include #include /* PARAMETER translations */ #define MACT1D 5 #define MECONT 50 #define MEFVEC 61 #define MEMLIN 13 #define MEMUNI 15 #define MERET 51 #define METDIG 22 /* end of PARAMETER translations */ void /*FUNCTION*/ svecpr( float v[], long n, char *text, long lwidth, long lunit, long numdig) { static char ttext[1][3]; long int k, mact[9], _i, _r; static long mact1[MACT1D]={METDIG,0,MEFVEC,0,MERET}; static int _aini = 1; /* OFFSET Vectors w/subscript range: 1 to dimension */ long *const Mact = &mact[0] - 1; long *const Mact1 = &mact1[0] - 1; float *const V = &v[0] - 1; /* end of OFFSET VECTORS */ if( _aini ){ /* Do 1 TIME INITIALIZATIONS! */ strcpy( ttext[0], " " ); _aini = 0; } /* Copyright (c) 1996 California Institute of Technology, Pasadena, CA. * ALL RIGHTS RESERVED. * Based on Government Sponsored Research NAS7-03001. *>> 2010-02-22 SVECPR Krogh Initliazed TTEXT to avoid compiler worrirs. *>> 2000-12-01 SVECPR Krogh Removed unused parameter METXTF. *>> 1994-11-11 SVECPR Krogh Declared all vars. *>> 1994-10-20 SVECPR Krogh Added M77CON code. *>> 1992-05-03 SVECPR Krogh Convert to use MESSFT for Fortran text. *>> 1992-04-08 SVECPR Krogh Replaced dummy K with MACT in ?MESS call. *>> 1991-11-22 SVECPR F. Krogh Initial code *++I DEFAULT MACT1D=3, TAIL=", LUNIT" *++ DEFAULT MACT1D=5, TAIL=", LUNIT, NUMDIG" *++ REPLACE ", LUNIT, NUMDIG" = TAIL *--S replaces "?": ?VECPR, ?MESS * * ***** Formal Arguments *********************************** * * V Vector to be output, V = V(I), I = 1, N * N Number of vector components. * TEXT a variable length character type that gives a message to print. * LWIDTH Line width in characters. If this or any of the following * parameter are < 0, then current defaults set in MESS are used. * LUNIT Logical unit number. (0 prints to the standard output.) * NUMDIG Number of significant digits to print (Not used for integer). * * ******************** Parameter for interfacing to MESS ************* * */ /*++ Substitute for MACT1D below */ /*--S Next line special: I */ /*++ Code for {I} is inactive * integer MEIVEC * parameter (MEIVEC=57) * data MACT1 / MEIVEC, 0, MERET / * MACT1(2) = max(N, 0) *++ Code for ~{I} is active */ Mact1[2] = max( 0, numdig ); Mact1[4] = max( n, 0 ); /*++ End * */ k = 1; if (lwidth > 20) { Mact[1] = -MEMLIN; Mact[3] = MEMLIN; Mact[4] = lwidth; k = 5; } if (lunit >= 0) { Mact[k] = -MEMUNI; Mact[k + 2] = MEMUNI; Mact[k + 3] = lunit; k += 4; } Mact[k] = MECONT; if (k > 1) messft( mact, text ); /*++ Code for {I} is inactive * call MESS(MACT1, TTEXT, V) *++ Code for ~{I} is active */ smess( mact1, (char*)ttext,3, mact, v ); /*++ End */ if (Mact[1] < 0) { /* Restore MESS parameters to original state */ Mact[1] = -Mact[1]; Mact[3] = MERET; if (Mact[5] < 0) { Mact[3] = MEMUNI; Mact[4] = Mact[6]; Mact[5] = MERET; } mess( mact, (char*)ttext,3, mact ); } return; } /* end of function */