File: N:\mfix\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     
33           USE compar
34           USE mpi_utility
35           USE indices
36           USE functions
37           use machine
38     
39           IMPLICIT NONE
40     !-----------------------------------------------
41     !   G l o b a l   P a r a m e t e r s
42     !-----------------------------------------------
43     !-----------------------------------------------
44     !   D u m m y   A r g u m e n t s
45     !-----------------------------------------------
46     !
47     !                      Local index
48           INTEGER          L
49     !
50     !                      Phase index
51           INTEGER          M
52     !
53     !                      cell index
54           INTEGER          IJK
55     !
56     !                      Septadiagonal matrix A_m
57           DOUBLE PRECISION A_m(DIMENSION_3, -3:3, 0:DIMENSION_M)
58     !
59     !                      Source vector
60           DOUBLE PRECISION b_m(DIMENSION_3, 0:DIMENSION_M)
61     
62           double precision, allocatable :: array1(:) , array2(:)   !//
63           double precision, allocatable :: am(:,:)                !//
64     !
65     !-----------------------------------------------
66     !
67           integer i, j, k
68     
69           if (myPE == PE_IO) then
70              allocate (array1(ijkmax3))
71              allocate (array2(ijkmax3))
72              allocate (am(ijkmax3,-3:3))
73           else
74              allocate (array1(1))
75              allocate (array2(1))
76              allocate (am(1,-3:3))
77           end if
78     
79           if (myPE == PE_IO) then
80              CALL START_LOG
81              IF(DMP_LOG)WRITE (UNIT_LOG,*) ' 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'
89           end if
90     
91     
92     
93           call gather(b_m(:,M),array2,root)
94     
95     
96           do L = -3,3
97     
98           call gather(a_m(:,L,M),array1,root)
99     
100           DO K = Kmin2, Kmax2
101           DO I = Imin2, Imax2
102           DO J = Jmin2, Jmax2
103     
104           IF (DEAD_CELL_AT(I,J,K)) CYCLE  ! skip dead cells
105     
106     !     IJK = FUNIJK_GL(IMAP_C(I),JMAP_C(J),KMAP_C(K))
107           IJK = FUNIJK_GL(I,J,K)
108     
109           if (myPE == PE_IO) am(ijk,l) = array1(ijk)
110     
111     
112           END DO
113           END DO
114           END DO
115     
116           end do
117     
118           DO K = Kmin2, Kmax2
119           DO I = Imin2, Imax2
120           DO J = Jmin2, Jmax2
121     
122           IF (DEAD_CELL_AT(I,J,K)) CYCLE  ! skip dead cells
123     
124           IJK = FUNIJK_GL(I,J,K)
125     
126             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,&
127                                         (AM(ijk,L),L=-3,3), array2(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
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