SUBROUTINE FMOUT (IUNIT,NCOL,S,W,F,IDIMA,N,M,A) C C FUNCTION: CF CF This routine outputs a matrix to a specified output device CF with NCOL columns per line with S spaces between each CF column using the field descriptor 1PDW.F, up to a maximum of CF 255 columns per line. If S = 0, the spacing defaults to CF 5 spaces between each column. If W = 0, the default format CF descriptor 1PD20.13 is used. If NCOL = 0, then the columns CF are output in free format. CF C USAGE: CU CU C INPUTS: CI CI IUNIT - INTEGER, the unit number which A will be output on. CI CI NCOL - INTEGER, The number of columns of A which will be printed CI per line on the output device. CI CI S - INTEGER, the number of spaces between each column of output. CI CI W,F - INTEGERs, are the components W and F of the field CI descriptor 1PDW.F CI CI IDIMA is the row dimension of A as declared in the calling program. CI CI N - The number of rows of A. CI CI M - The number of columns of A. CI CI A - The double precision matrix to be output. CI C OUTPUTS: CO CO NONE. CO C ALGORITHM: CA CA NONE. CA C MACHINE DEPENDENCIES: CM CM NONE. CM C HISTORY: CH CH written by: bobby bodenheimer CH date: september 1986 CH current version: 1.2 CH modifications: removed vax/vms dependence - jdb - 5/9/88 CH defined undefined variables - jdb - 5/13/88 CH C ROUTINES CALLED: CC CC NONE. CC C---------------------------------------------------------------------- C written for: The CASCADE Project C Oak Ridge National Laboratory C U.S. Department of Energy C contract number DE-AC05-840R21400 C subcontract number 37B-7685 S13 C organization: The University of Tennessee C---------------------------------------------------------------------- C THIS SOFTWARE IS IN THE PUBLIC DOMAIN C NO RESTRICTIONS ON ITS USE ARE IMPLIED C---------------------------------------------------------------------- C C C Global variables C INTEGER IUNIT INTEGER NCOL INTEGER S INTEGER W INTEGER F INTEGER IDIMA INTEGER N INTEGER M C DOUBLE PRECISION A(IDIMA,M) C C Local variables: C INTEGER CLOW INTEGER CHIGH LOGICAL LAST CHARACTER*50 FMT CHARACTER*2 CS CHARACTER*2 CW CHARACTER*2 CF INTEGER I INTEGER J INTEGER K C C Begin C IF (NCOL.EQ.0) THEN DO 10, I = 1,N WRITE(IUNIT,*) (A(I,J),J=1,M) 10 CONTINUE RETURN END IF C C NCOL is non-zero. C DO 500 J = 1, N LAST = .FALSE. CLOW = 1 CHIGH = MIN(NCOL,M) 200 IF(S.EQ.0.AND.W.EQ.0) THEN WRITE (IUNIT,1110) (A(J,K),K=CLOW,CHIGH) 1110 FORMAT(255(5X,1PD20.13)) ELSE IF (S.EQ.0.AND.W.NE.0) THEN WRITE (CW,1120) W WRITE (CF,1120) F 1120 FORMAT (BZ,I2) FMT = '(255(5X,1PD'//CW//'.'//CF//'))' WRITE (IUNIT,FMT) (A(J,K),K=CLOW,CHIGH) ELSE IF(S.NE.0.AND.W.EQ.0) THEN WRITE (CS,1120) S FMT = '(255('//CS//'X,1PD20.13))' WRITE (IUNIT,FMT) (A(J,K),K=CLOW,CHIGH) ELSE WRITE (CS,1120) S WRITE (CW,1120) W WRITE (CF,1120) F FMT = '(255('//CS//'X,1PD'//CW//'.'//CF//'))' WRITE (IUNIT,FMT) (A(J,K),K=CLOW,CHIGH) END IF CLOW = CLOW + NCOL CHIGH = CHIGH + NCOL IF (LAST) GO TO 500 IF (CHIGH.GE.M) THEN LAST = .TRUE. CHIGH = M END IF GO TO 200 500 WRITE(IUNIT,1000) 1000 FORMAT(/) RETURN END