download dmout.f
Language: Fortran
LOC: 146
Project Info
Scientific Data Tools(sds)
Server: BerliOS
Type: cvs
...\sdsfortranlibs‑1.0\approx\
   bndacc.f
   bndsol.f
   bsplvd.f
   bsplvn.f
   chkder.f
   d1mach.f
   dasum.f
   daxpy.f
   dbndac.f
   dbndsl.f
   dbocls.f
   dbols.f
   dbolsm.f
   dckder.f
   dcopy.f
   dcov.f
   ddot.f
   defc.f
   defcmn.f
   denorm.f
   dfc.f
   dfcmn.f
   dfdjc3.f
   dfspvd.f
   dfspvn.f
   dh12.f
   dhfti.f
   dlpdp.f
   dlsei.f
   dlsi.f
   dmout.f
   dmpar.f
   dnls1.f
   dnls1e.f
   dnrm2.f
   dp1vlu.f
   dpcoef.f
   dpolft.f
   dqrfac.f
   dqrslv.f
   drot.f
   drotg.f
   drotm.f
   drotmg.f
   dscal.f
   dsort.f
   dswap.f
   dvout.f
   dwnlit.f
   dwnlsm.f
   dwnlt1.f
   dwnlt2.f
   dwnlt3.f
   dwnnls.f
   dwupdt.f
   efc.f
   efcmn.f
   enorm.f
   fc.f
   fcmn.f
   fdjac3.f
   fdump.f
   h12.f
   hfti.f
   i1mach.f
   idamax.f
   isamax.f
   ivout.f
   j4save.f
   lmpar.f
   lpdp.f
   lsei.f
   lsi.f
   pcoef.f
   polfit.f
   pvalue.f
   qrfac.f
   qrsolv.f
   r1mach.f
   rwupdt.f
   sasum.f
   saxpy.f
   sbocls.f
   sbols.f
   sbolsm.f
   scopy.f
   scov.f
   sdot.f
   smout.f
   snls1.f
   snls1e.f
   snrm2.f
   srot.f
   srotg.f
   srotm.f
   srotmg.f
   sscal.f
   ssort.f
   sswap.f
   svout.f
   wnlit.f
   wnlsm.f
   wnlt1.f
   wnlt2.f
   wnlt3.f
   wnnls.f
   xerclr.f
   xercnt.f
   xerhlt.f
   xermsg.f
   xerprn.f
   xersve.f
   xgetf.f
   xgetua.f
   xsetf.f

*DECK DMOUT
      SUBROUTINE DMOUT (M, N, LDA, A, IFMT, IDIGIT)
C***BEGIN PROLOGUE  DMOUT
C***SUBSIDIARY
C***PURPOSE  Subsidiary to DBOCLS and DFC
C***LIBRARY   SLATEC
C***TYPE      DOUBLE PRECISION (SMOUT-S, DMOUT-D)
C***AUTHOR  Hanson, R. J., (SNLA)
C           Wisniewski, J. A., (SNLA)
C***DESCRIPTION
C
C     DOUBLE PRECISION MATRIX OUTPUT ROUTINE.
C
C  INPUT..
C
C  M,N,LDA,A(*,*) PRINT THE DOUBLE PRECISION ARRAY A(I,J),I = 1,...,M,
C                 J=1,...,N, ON OUTPUT UNIT LOUT=6. LDA IS THE DECLARED
C                 FIRST DIMENSION OF A(*,*) AS SPECIFIED IN THE CALLING
C                 PROGRAM. THE HEADING IN THE FORTRAN FORMAT STATEMENT
C                 IFMT(*), DESCRIBED BELOW, IS PRINTED AS A FIRST STEP.
C                 THE COMPONENTS A(I,J) ARE INDEXED, ON OUTPUT, IN A
C                 PLEASANT FORMAT.
C  IFMT(*)        A FORTRAN FORMAT STATEMENT. THIS IS PRINTED ON
C                 OUTPUT UNIT LOUT=6 WITH THE VARIABLE FORMAT FORTRAN
C                 STATEMENT
C                       WRITE(LOUT,IFMT).
C  IDIGIT         PRINT AT LEAST ABS(IDIGIT) DECIMAL DIGITS PER NUMBER.
C                 THE SUBPROGRAM WILL CHOOSE THAT INTEGER 4,6,14,20 OR
C                 28 WHICH WILL PRINT AT LEAST ABS(IDIGIT) NUMBER OF
C                 PLACES.  IF IDIGIT.LT.0, 72 PRINTING COLUMNS ARE
C                 UTILIZED TO WRITE EACH LINE OF OUTPUT OF THE ARRAY
C                 A(*,*). (THIS CAN BE USED ON MOST TIME-SHARING
C                 TERMINALS).  IF IDIGIT.GE.0, 133 PRINTING COLUMNS ARE
C                 UTILIZED. (THIS CAN BE USED ON MOST LINE PRINTERS).
C
C  EXAMPLE..
C
C  PRINT AN ARRAY CALLED (SIMPLEX TABLEAU   ) OF SIZE 10 BY 20 SHOWING
C  6 DECIMAL DIGITS PER NUMBER. THE USER IS RUNNING ON A TIME-SHARING
C  SYSTEM WITH A 72 COLUMN OUTPUT DEVICE.
C
C     DOUBLE PRECISION TABLEU(20,20)
C     M = 10
C     N = 20
C     LDTABL = 20
C     IDIGIT = -6
C     CALL DMOUT(M,N,LDTABL,TABLEU,21H(16H1SIMPLEX TABLEAU),IDIGIT)
C
C***SEE ALSO  DBOCLS, DFC
C***ROUTINES CALLED  I1MACH
C***REVISION HISTORY  (YYMMDD)
C   821220  DATE WRITTEN
C   890531  Changed all specific intrinsics to generic.  (WRB)
C   891107  Added comma after 1P edit descriptor in FORMAT
C           statements.  (WRB)
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C   900328  Added TYPE section.  (WRB)
C   910403  Updated AUTHOR section.  (WRB)
C***END PROLOGUE  DMOUT
      DOUBLE PRECISION A(LDA,*)
      CHARACTER IFMT*(*),ICOL*3
      SAVE ICOL
      DATA ICOL /'COL'/
C***FIRST EXECUTABLE STATEMENT  DMOUT
      LOUT=I1MACH(2)
      WRITE(LOUT,IFMT)
      IF(M.LE.0.OR.N.LE.0.OR.LDA.LE.0) RETURN
      NDIGIT = IDIGIT
      IF(IDIGIT.EQ.0) NDIGIT = 4
      IF(IDIGIT.GE.0) GO TO 80
C
      NDIGIT = -IDIGIT
      IF(NDIGIT.GT.4) GO TO 9
C
      DO 5 K1=1,N,5
      K2 = MIN(N,K1+4)
      WRITE(LOUT,1010) (ICOL,I,I = K1, K2)
      DO 5 I = 1, M
      WRITE(LOUT,1009) I,(A(I,J),J = K1, K2)
   5  CONTINUE
      RETURN
C
   9  CONTINUE
      IF(NDIGIT.GT.6) GO TO 20
C
      DO 10 K1=1,N,4
      K2 = MIN(N,K1+3)
      WRITE(LOUT,1000) (ICOL,I,I = K1, K2)
      DO 10 I = 1, M
      WRITE(LOUT,1004) I,(A(I,J),J = K1, K2)
   10 CONTINUE
      RETURN
C
   20 CONTINUE
      IF(NDIGIT.GT.14) GO TO 40
C
      DO 30 K1=1,N,2
      K2 = MIN(N,K1+1)
      WRITE(LOUT,1001) (ICOL,I,I = K1, K2)
      DO 30 I = 1, M
      WRITE(LOUT,1005) I,(A(I,J),J = K1, K2)
   30 CONTINUE
      RETURN
C
   40 CONTINUE
      IF(NDIGIT.GT.20) GO TO 60
C
      DO 50 K1=1,N,2
      K2=MIN(N,K1+1)
      WRITE(LOUT,1002) (ICOL,I,I = K1, K2)
      DO 50 I = 1, M
      WRITE(LOUT,1006) I,(A(I,J),J = K1, K2)
   50 CONTINUE
      RETURN
C
   60 CONTINUE
      DO 70 K1=1,N
      K2 = K1
      WRITE(LOUT,1003) (ICOL,I,I = K1, K2)
      DO 70 I = 1, M
      WRITE(LOUT,1007) I,(A(I,J),J = K1, K2)
   70 CONTINUE
      RETURN
C
   80 CONTINUE
      IF(NDIGIT.GT.4) GO TO 86
C
      DO 85 K1=1,N,10
      K2 = MIN(N,K1+9)
      WRITE(LOUT,1000) (ICOL,I,I = K1, K2)
      DO 85 I = 1, M
      WRITE(LOUT,1009) I,(A(I,J),J = K1, K2)
   85 CONTINUE
C
86    IF (NDIGIT.GT.6) GO TO 100
C
      DO 90 K1=1,N,8
      K2 = MIN(N,K1+7)
      WRITE(LOUT,1000) (ICOL,I,I = K1, K2)
      DO 90 I = 1, M
      WRITE(LOUT,1004) I,(A(I,J),J = K1, K2)
   90 CONTINUE
      RETURN
C
  100 CONTINUE
      IF(NDIGIT.GT.14) GO TO 120
C
      DO 110 K1=1,N,5
      K2 = MIN(N,K1+4)
      WRITE(LOUT,1001) (ICOL,I,I = K1, K2)
      DO 110 I = 1, M
      WRITE(LOUT,1005) I,(A(I,J),J = K1, K2)
  110 CONTINUE
      RETURN
C
  120 CONTINUE
      IF(NDIGIT.GT.20) GO TO 140
C
      DO 130 K1=1,N,4
      K2 = MIN(N,K1+3)
      WRITE(LOUT,1002) (ICOL,I,I = K1, K2)
      DO 130 I = 1, M
      WRITE(LOUT,1006) I,(A(I,J),J = K1, K2)
  130 CONTINUE
      RETURN
C
  140 CONTINUE
      DO 150 K1=1,N,3
      K2 = MIN(N,K1+2)
      WRITE(LOUT,1003) (ICOL,I,I = K1, K2)
      DO 150 I = 1, M
      WRITE(LOUT,1007) I,(A(I,J),J = K1, K2)
  150 CONTINUE
      RETURN
 1000 FORMAT(10X,8(5X,A,I4,2X))
 1001 FORMAT(10X,5(9X,A,I4,6X))
 1002 FORMAT(10X,4(12X,A,I4,9X))
 1003 FORMAT(10X,3(16X,A,I4,13X))
 1004 FORMAT(1X,3HROW,I4,2X,1P,8D14.5)
 1005 FORMAT(1X,3HROW,I4,2X,1P,5D22.13)
 1006 FORMAT(1X,3HROW,I4,2X,1P,4D28.19)
 1007 FORMAT(1X,3HROW,I4,2X,1P,3D36.27)
 1009 FORMAT(1X,3HROW,I4,2X,1P,10D12.3)
 1010 FORMAT(10X,10(4X,A,I4,1X))
      END

About Koders | Resources | Downloads | Support | Black Duck | Submit Project | Terms of Service | DMCA | Privacy Policy | Site Map| Contact Us