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

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