File: RELATIVE:/../../../mfix.git/model/out_array_k.f

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