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