File: N:\mfix\model\write_ab_m_var.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2     !                                                                      C
3     !  Module name: Write_Ab_m_var(A_m, b_m, var, IER)                  C
4     !  Purpose: Write the sparse matrix coefficients and the               C
5     !           source vector.                                             C
6     !                                                                      C
7     !                                                                      C
8     !  Literature/Document References:                                     C
9     !                                                                      C
10     !  Variables referenced:                                               C
11     !  Variables modified:                                                 C
12     !                                                                      C
13     !  Local variables:                                                    C
14     !                                                                      C
15     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
16     !
17           SUBROUTINE WRITE_AB_M_VAR(A_M, B_M, VAR)
18     !...Translated by Pacific-Sierra Research VAST-90 2.06G5  12:17:31  12/09/98
19     !...Switches: -xf
20     !
21     !  Include param.inc file to specify parameter values
22     !
23     !-----------------------------------------------
24     !   M o d u l e s
25     !-----------------------------------------------
26           USE param
27           USE param1
28     
29           USE geometry
30           USE compar
31           USE mpi_utility
32           USE indices
33           USE functions
34     
35           use machine
36     
37           IMPLICIT NONE
38     !-----------------------------------------------
39     !   G l o b a l   P a r a m e t e r s
40     !-----------------------------------------------
41     !-----------------------------------------------
42     !   D u m m y   A r g u m e n t s
43     !-----------------------------------------------
44     !
45     !                      Local index
46           INTEGER          L
47     !
48     !                      cell index
49           INTEGER          IJK
50     !
51     !                      Septadiagonal matrix A_m
52           DOUBLE PRECISION A_m(DIMENSION_3, -3:3)
53     !
54     !                      Source vector
55           DOUBLE PRECISION b_m(DIMENSION_3)
56     
57     !                      Source vector
58           DOUBLE PRECISION var(DIMENSION_3)
59     
60           double precision, allocatable :: array1(:) , array2(:)   !//
61           double precision, allocatable :: am(:,:)                !//
62     !
63     !-----------------------------------------------
64     !
65           integer i, j, k
66     
67           if (myPE == PE_IO) then
68              allocate (array1(ijkmax3))
69              allocate (array2(ijkmax3))
70              allocate (am(ijkmax3,-3:3))
71           else
72              allocate (array1(1))
73              allocate (array2(1))
74              allocate (am(1,-3:3))
75           end if
76     
77           if (myPE == PE_IO) then
78              CALL START_LOG
79              IF(DMP_LOG)WRITE (UNIT_LOG,*) ' Note : write_am_m is VERY inefficient '
80              WRITE (*,*) ' Note : write_am_m is VERY inefficient '
81              IF(DMP_LOG)WRITE (UNIT_LOG,*) '  '
82              IF(DMP_LOG)WRITE (UNIT_LOG,*) ' A_m and B_m arrays below are in the '
83              IF(DMP_LOG)WRITE (UNIT_LOG,*) ' mfix INTERNAL order'
84              IF(DMP_LOG)WRITE (UNIT_LOG,*) ' '
85              IF(DMP_LOG)WRITE (UNIT_LOG, '(A,A)') &
86                '  IJK  I  J  K   b         s         w         p         e       ', &
87                '  n         t        Source     Variable'
88           end if
89     
90     
91           do L = -3,3
92     
93           call gather(a_m(:,L),array1,root)
94     
95           DO K = Kmin2, Kmax2
96           DO I = Imin2, Imax2
97           DO J = Jmin2, Jmax2
98     
99           IF (DEAD_CELL_AT(I,J,K)) CYCLE  ! skip dead cells
100     
101           IJK = FUNIJK_GL(IMAP_C(I),JMAP_C(J),KMAP_C(K))
102     !     IJK = FUNIJK_GL(I,J,K)
103     
104           if (myPE == PE_IO) am(ijk,l) = array1(ijk)
105     
106     
107           END DO
108           END DO
109           END DO
110     
111           end do
112     
113           call gather(var(:),array1,root)
114           call gather(b_m(:),array2,root)
115     
116           DO K = Kmin2, Kmax2
117           DO I = Imin2, Imax2
118           DO J = Jmin2, Jmax2
119     
120           IF (DEAD_CELL_AT(I,J,K)) CYCLE  ! skip dead cells
121     
122     !     IJK = FUNIJK_GL(I,J,K)
123           IJK = FUNIJK_GL(IMAP_C(I),JMAP_C(J),KMAP_C(K))
124     
125             if (myPE == PE_IO .AND. DMP_LOG)WRITE (UNIT_LOG, '(I5, 3(I3), 9(1X,G9.2))') FUNIJK_IO(I,J,K), I, J, K,&
126                                         (AM(ijk,L),L=-3,3), array2(IJK), array1(IJK)
127     
128           END DO
129           END DO
130           END DO
131     
132           if (myPE == PE_IO) CALL END_LOG
133     
134     
135           deallocate (array1)    !//
136           deallocate (array2)    !//
137     
138           RETURN
139           END SUBROUTINE WRITE_AB_M_VAR
140     
141     !// Comments on the modifications for DMP version implementation
142     !// 001 Include header file and common declarations for parallelization
143     !// 020 New local variables for parallelization: array1,array2,i,j,k
144     !// 400 Added mpi_utility module and other global reduction (gather) calls
145