File: RELATIVE:/../../../mfix.git/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           USE matrix
29     
30           USE geometry
31           USE compar
32           USE mpi_utility
33           USE indices
34           USE functions
35     
36           use machine
37     
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     !                      Local index
47           INTEGER          L
48     !
49     !                      cell index
50           INTEGER          IJK
51     !
52     !                      Septadiagonal matrix A_m
53           DOUBLE PRECISION A_m(DIMENSION_3, -3:3)
54     !
55     !                      Source vector
56           DOUBLE PRECISION b_m(DIMENSION_3)
57     
58     !                      Source vector
59           DOUBLE PRECISION var(DIMENSION_3)
60     
61           double precision, allocatable :: array1(:) , array2(:)   !//
62           double precision, allocatable :: am(:,:)                !//
63     !
64     !-----------------------------------------------
65     !
66           integer i, j, k
67     
68           if (myPE == PE_IO) then
69              allocate (array1(ijkmax3))
70              allocate (array2(ijkmax3))
71              allocate (am(ijkmax3,-3:3))
72           else
73              allocate (array1(1))
74              allocate (array2(1))
75              allocate (am(1,-3:3))
76           end if
77     
78           if (myPE == PE_IO) then
79              CALL START_LOG
80              IF(DMP_LOG)WRITE (UNIT_LOG,*) ' Note : write_am_m is VERY inefficient '
81              WRITE (*,*) ' Note : write_am_m is VERY inefficient '
82              IF(DMP_LOG)WRITE (UNIT_LOG,*) '  '
83              IF(DMP_LOG)WRITE (UNIT_LOG,*) ' A_m and B_m arrays below are in the '
84              IF(DMP_LOG)WRITE (UNIT_LOG,*) ' mfix INTERNAL order'
85              IF(DMP_LOG)WRITE (UNIT_LOG,*) ' '
86              IF(DMP_LOG)WRITE (UNIT_LOG, '(A,A)') &
87                '  IJK  I  J  K   b         s         w         p         e       ', &
88                '  n         t        Source     Variable'
89           end if
90     
91     
92           do L = -3,3
93     
94           call gather(a_m(:,L),array1,root)
95     
96           DO K = Kmin2, Kmax2
97           DO I = Imin2, Imax2
98           DO J = Jmin2, Jmax2
99     
100           IF (DEAD_CELL_AT(I,J,K)) CYCLE  ! skip dead cells
101     
102           IJK = FUNIJK_GL(IMAP_C(I),JMAP_C(J),KMAP_C(K))
103     !     IJK = FUNIJK_GL(I,J,K)
104     
105           if (myPE == PE_IO) am(ijk,l) = array1(ijk)
106     
107     
108           END DO
109           END DO
110           END DO
111     
112           end do
113     
114           call gather(var(:),array1,root)
115           call gather(b_m(:),array2,root)
116     
117           DO K = Kmin2, Kmax2
118           DO I = Imin2, Imax2
119           DO J = Jmin2, Jmax2
120     
121           IF (DEAD_CELL_AT(I,J,K)) CYCLE  ! skip dead cells
122     
123     !     IJK = FUNIJK_GL(I,J,K)
124           IJK = FUNIJK_GL(IMAP_C(I),JMAP_C(J),KMAP_C(K))
125     
126             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,&
127                                         (AM(ijk,L),L=-3,3), array2(IJK), array1(IJK)
128     
129           END DO
130           END DO
131           END DO
132     
133           if (myPE == PE_IO) CALL END_LOG
134     
135     
136           deallocate (array1)    !//
137           deallocate (array2)    !//
138     
139           RETURN
140           END SUBROUTINE WRITE_AB_M_VAR
141     
142     !// Comments on the modifications for DMP version implementation
143     !// 001 Include header file and common declarations for parallelization
144     !// 020 New local variables for parallelization: array1,array2,i,j,k
145     !// 400 Added mpi_utility module and other global reduction (gather) calls
146