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