File: /nfs/home/0/users/jenkins/mfix.git/model/out_array_kc.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2     !                                                                      C
3     !  Module name: OUT_ARRAY_KC (ARRAY, K)                                C
4     !  Purpose: print out a 2D (constant k-plane) array to standard output C
5     !           (character)                                                C
6     !                                                                      C
7     !  Author: P.Nicoletti                                Date: 02-DEC-91  C
8     !  Reviewer: W. Rogers, M. Syamlal, S. Venkatesan     Date: 31-JAN-92  C
9     !                                                                      C
10     !  Revision Number:                                                    C
11     !  Purpose:                                                            C
12     !  Author:                                            Date: dd-mmm-yy  C
13     !  Reviewer:                                          Date: dd-mmm-yy  C
14     !                                                                      C
15     !  Literature/Document References:                                     C
16     !                                                                      C
17     !  Variables referenced: IMAX2, JMAX2                                  C
18     !  Variables modified: None                                            C
19     !                                                                      C
20     !  Local variables: NCOL, NTAB, LL1, LL2, LL3, IFORM1, IFORM2, IJK, IJ2
21     !                                                                      C
22     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
23           SUBROUTINE OUT_ARRAY_KC(ARRAY)
24     !...Translated by Pacific-Sierra Research VAST-90 2.06G5  12:17:31  12/09/98
25     !...Switches: -xf
26     !
27     !-----------------------------------------------
28     !   M o d u l e s
29     !-----------------------------------------------
30           USE param
31           USE param1
32           USE geometry
33           USE fldvar
34           USE physprop
35           USE indices
36           USE funits
37           USE compar
38           USE mpi_utility
39           USE functions
40           IMPLICIT NONE
41     !-----------------------------------------------
42     !   G l o b a l   P a r a m e t e r s
43     !-----------------------------------------------
44     !-----------------------------------------------
45     !   D u m m y   A r g u m e n t s
46     !-----------------------------------------------
47     !
48     !                      2D array to print out
49           CHARACTER(LEN=4) :: ARRAY(*)
50     !
51     ! local variables
52     !
53     !                      A line of characters to print
54           CHARACTER(LEN=132) :: LINE
55     !
56     !                      number of columns to print out across the page
57           INTEGER          NCOL
58     !
59     !                      number of tables the 2D array must be split into
60     !                      for printing
61           INTEGER          NTAB
62     !
63     !                      loop indices
64           INTEGER          LL1, LL2, LL3, LL4
65     !
66     !                      start and end 'I' for current table
67           INTEGER          IFORM1 , IFORM2
68     !
69     !                      start 'IJ' and end 'IJ' for a given 'J' to print out
70           INTEGER          IJK , IJ2
71     !
72     !-----------------------------------------------
73     
74     !
75     ! NOTE:  IF NCOL IS CHANGED TO A NUMBER OTHER THAN 24, THEN THE "24"
76     !        IN FORMATS 5050 AND 5100 MUST BE CHANGED TO THAT NUMBER.
77     !
78           NCOL = 24
79           NTAB = IMAX2/NCOL + 1
80           IF (MOD(IMAX2,NCOL) == 0) NTAB = NTAB - 1
81     !
82           DO LL1 = 1, NTAB
83              IFORM1 = 1 + NCOL*(LL1 - 1)
84              IFORM2 = NCOL*LL1
85              IFORM2 = MIN(IFORM2,IMAX2)
86              WRITE (UNIT_OUT, 5050) (LL3,LL3=IFORM1,IFORM2)
87              DO LL2 = JMAX2, 1, -1
88                 IJK = funijk_io(IFORM1,LL2,1)
89                 IJ2 = funijk_io(IFORM2,LL2,1)
90     !efd
91                 WRITE (LINE, 5100) LL2, (ARRAY(LL3),LL3=IJK,IJ2)
92     
93                 LL4 = 12 + (IFORM2 - IFORM1 + 1)*5
94                 WRITE (UNIT_OUT, '(A)') LINE(1:LL4)
95              END DO
96           END DO
97     
98     
99      5050 FORMAT(3X,'J',3X,'I=',3X,24(I3,2X))
100      5100 FORMAT(1X,I3,8X,24(A4,1X))
101           RETURN
102           END SUBROUTINE OUT_ARRAY_KC
103