C Copyright(C) 1999-2020 National Technology & Engineering Solutions C of Sandia, LLC (NTESS). Under the terms of Contract DE-NA0003525 with C NTESS, the U.S. Government retains certain rights in this software. C C See packages/seacas/LICENSE for details C======================================================================= SUBROUTINE PRNSV (NOUT, NSTEP, NUMNPS, LISNPS, LNPSNL, & IDNPS, NNNPS, IXNNPS, LTNNPS, NAME, $ NVAR, LISVAR, NAMEV, ISVOK, VARS, nvardm, $ MAPNO, DOMAP) C======================================================================= C --*** PRNPS *** (EXPLORE) Display database nodal point set C -- C --PRNPS displays the nodal point sets. C -- C --Parameters: C -- NOUT - IN - the output file, <=0 for standard C -- NUMNPS - IN - the number of nodal point sets C -- LISNPS - IN - the indices of the selected nodal point sets C -- LNPSNL - IN - the number of nodes for all sets C -- IDNPS - IN - the nodal point set ID for each set C -- NNNPS - IN - the number of nodes for each set C -- NDNPS - IN - the number of distribution factors for each set C -- IXNNPS - IN - the index of the first node for each set C -- IXDNPS - IN - the index of the first dist factor for each set C -- LTNNPS - IN - the nodes for all sets C -- FACNPS - IN - the distribution factors for all sets include 'exodusII.inc' include 'exp_dbase.blk' INTEGER LISNPS(0:*) INTEGER IDNPS(*) INTEGER NNNPS(*) INTEGER IXNNPS(*) INTEGER LTNNPS(*) CHARACTER*(*) NAME(*) INTEGER LISVAR(0:*) CHARACTER*(*) NAMEV(*) INTEGER ISVOK(nvardm,*) REAL VARS(LNPSNL, *) INTEGER MAPNO(*) LOGICAL DOMAP CHARACTER*32 CVAL(6) CHARACTER*40 FMT20,FMT30, FMT40 INTEGER PRTLEN INTEGER GETPRC CHARACTER*20 STRA, STRB C ... See if need to read the data if (nstep .ne. nstepns) then nstepns = nstep DO 20 IX = 1, LISNPS(0) INPS = LISNPS(IX) ID = idnps(inps) IS = IXNNPS(INPS) DO 10 IVAR = 1, LISVAR(0) IF (ISVOK (LISVAR(IVAR),INPS) .NE. 0) THEN call exgnsv(ndb, nstep, lisvar(ivar), id, nnnps(inps), $ vars(is,lisvar(ivar)), ierr) end if 10 continue ioff = ioff + nnnps(inps) 20 continue end if PRTLEN = GETPRC() + 7 WRITE(FMT20,2000) PRTLEN, PRTLEN-7 WRITE(FMT30,3000) PRTLEN WRITE(FMT40,4000) PRTLEN IF (NOUT .GT. 0) WRITE (NOUT, 10000) if (domap) then if (nout .gt. 0) then write (nout, 10005) else write (*, 10005) end if end if do 90 i=1, lisvar(0) irow = ((i-1)/5)+1 icol = i - (irow-1)*5 IF (NOUT .GT. 0) THEN WRITE (NOUT, 10010) irow, icol, NAMEV(LISVAR(I)) ELSE WRITE (*, 10010) irow, icol, NAMEV(LISVAR(I)) END IF 90 continue WRITE (STRA, 10001, IOSTAT=IDUM) NUMNPS 10001 FORMAT ('(#', I4, ')') CALL PCKSTR (1, STRA) LSTRA = LENSTR (STRA) WRITE (STRB, 10002, IOSTAT=IDUM) LNPSNL 10002 FORMAT ('(index=', I12, ')') CALL PCKSTR (1, STRB) LSTRB = LENSTR (STRB) DO 200 IX = 1, LISNPS(0) INPS = LISNPS(IX) WRITE (STRA, 10001, IOSTAT=IDUM) INPS CALL PCKSTR (1, STRA) WRITE (STRB, 10002, IOSTAT=IDUM) IXNNPS(INPS) CALL PCKSTR (1, STRB) IF (NOUT .GT. 0) THEN WRITE (NOUT, 10030, IOSTAT=IDUM) & IDNPS(INPS), STRA(:LSTRA), & NNNPS(INPS), STRB(:LSTRB), $ NAME(INPS)(:LENSTR(NAME(INPS))) ELSE WRITE (*, 10030, IOSTAT=IDUM) & IDNPS(INPS), STRA(:LSTRA), & NNNPS(INPS), STRB(:LSTRB), $ NAME(INPS)(:LENSTR(NAME(INPS))) END IF IF (NNNPS(INPS) .GT. 0) THEN IS = IXNNPS(INPS) IE = IS + NNNPS(INPS) - 1 do 130 IN = IS,IE if (domap) then ID = MAPNO(LTNNPS(IN)) else ID = LTNNPS(IN) end if DO 110 IVAR = 1, LISVAR(0), 5 MINVAL = IVAR MAXVAL = MIN (LISVAR(0), IVAR+5-1) NVAL = MAXVAL - MINVAL + 1 DO 100 I = MINVAL, MAXVAL IF (ISVOK (LISVAR(I),INPS) .NE. 0) THEN WRITE (CVAL(I-MINVAL+1), FMT20, IOSTAT=IDUM) & VARS(IN, LISVAR(I)) ELSE CVAL(I-MINVAL+1) = '-----------' END IF 100 CONTINUE IF (IVAR .LE. 1) THEN IF (NOUT .GT. 0) THEN WRITE (NOUT, FMT30, IOSTAT=IDUM) & ID, (CVAL(I), I=1,NVAL) ELSE WRITE (*, FMT30, IOSTAT=IDUM) & ID, (CVAL(I), I=1,NVAL) END IF ELSE IF (NOUT .GT. 0) THEN WRITE (NOUT, FMT40, IOSTAT=IDUM) & (CVAL(I), I=1,NVAL) ELSE WRITE (*, FMT40, IOSTAT=IDUM) & (CVAL(I), I=1,NVAL) END IF END IF 110 CONTINUE 130 CONTINUE end if 200 CONTINUE RETURN 10000 FORMAT (/, 1X, 'NODESET TIME STEP VARIABLES') 10010 FORMAT (1X, 'Row ',I4,', Column ',I1,' is variable ',A) 2000 FORMAT('(1PE',I2.2,'.',I2.2,')') 3000 FORMAT('(1X, ''Node'', I12, 5(2X,A',I2,'))') 4000 FORMAT('(15X, 5 (2X, A',I2,'))') 10005 FORMAT (1X, 'Nodal ids are Global') 10030 FORMAT (/,1X, 'Set', I12, 1X, A, ':', & I12, ' nodes', 1X, A, ' name = "',A,'"') END