write_ab_m.f

Go to the documentation of this file.

!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
!                                                                      C
!  Module name: Write_Ab_m(A_m, b_m, IJKMAX2, M, IER)                  C                     C
!  Purpose: Write the sparse matrix coefficients and the               C
!           source vector.                                             C
!                                                                      C
!                                                                      C
!  Author: M. Syamlal                                 Date: 16-MAY-96  C
!  Reviewer:                                          Date:            C
!                                                                      C
!                                                                      C
!  Literature/Document References:                                     C
!                                                                      C
!  Variables referenced:                                               C
!  Variables modified:                                                 C
!                                                                      C
!  Local variables:                                                    C
!                                                                      C
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
!
      SUBROUTINE write_ab_m(A_M, B_M, M)    ! pnicol
!...Translated by Pacific-Sierra Research VAST-90 2.06G5  12:17:31  12/09/98
!...Switches: -xf
!
!  Include param.inc file to specify parameter values
!
!-----------------------------------------------
!   M o d u l e s
!-----------------------------------------------
      USE param
      USE param1

      USE compar
      USE mpi_utility
      USE indices
      USE functions
      use machine

      IMPLICIT NONE
!-----------------------------------------------
!   G l o b a l   P a r a m e t e r s
!-----------------------------------------------
!-----------------------------------------------
!   D u m m y   A r g u m e n t s
!-----------------------------------------------
!
!                      Local index
      INTEGER          L
!
!                      Phase index
      INTEGER          M
!
!                      cell index
      INTEGER          IJK
!
!                      Septadiagonal matrix A_m
      DOUBLE PRECISION A_m(dimension_3, -3:3, 0:dimension_m)
!
!                      Source vector
      DOUBLE PRECISION b_m(dimension_3, 0:dimension_m)

      double precision, allocatable :: array1(:) , array2(:)   !//
      double precision, allocatable :: am(:,:)                !//
!
!-----------------------------------------------
!
      integer i, j, k

      if (mype == pe_io) then
         allocate (array1(ijkmax3))
         allocate (array2(ijkmax3))
         allocate (am(ijkmax3,-3:3))
      else
         allocate (array1(1))
         allocate (array2(1))
         allocate (am(1,-3:3))
      end if

      if (mype == pe_io) then
         CALL start_log
         IF(dmp_log)WRITE (unit_log,*) ' Note : write_am_m is VERY inefficient '
         IF(dmp_log)WRITE (unit_log,*) '  '
         IF(dmp_log)WRITE (unit_log,*) ' A_m and B_m arrays below are in the '
         IF(dmp_log)WRITE (unit_log,*) ' mfix INTERNAL order'
         IF(dmp_log)WRITE (unit_log,*) ' '
         IF(dmp_log)WRITE (unit_log, '(A,A)') &
           '  IJK  I  J  K   b         s         w         p         e       ', &
           '  n         t        Source'
      end if



      call gather(b_m(:,m),array2,root)


      do l = -3,3

      call gather(a_m(:,l,m),array1,root)

      DO k = kmin2, kmax2
      DO i = imin2, imax2
      DO j = jmin2, jmax2

      IF (dead_cell_at(i,j,k)) cycle  ! skip dead cells

!     IJK = FUNIJK_GL(IMAP_C(I),JMAP_C(J),KMAP_C(K))
      ijk = funijk_gl(i,j,k)

      if (mype == pe_io) am(ijk,l) = array1(ijk)


      END DO
      END DO
      END DO

      end do

      DO k = kmin2, kmax2
      DO i = imin2, imax2
      DO j = jmin2, jmax2

      IF (dead_cell_at(i,j,k)) cycle  ! skip dead cells

      ijk = funijk_gl(i,j,k)

        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,&
                                    (am(ijk,l),l=-3,3), array2(ijk)

      END DO
      END DO
      END DO

      if (mype == pe_io) CALL end_log


      deallocate (array1)    !//
      deallocate (array2)    !//

      RETURN
      END SUBROUTINE write_ab_m

!// Comments on the modifications for DMP version implementation
!// 001 Include header file and common declarations for parallelization
!// 020 New local variables for parallelization: array1,array2,i,j,k
!// 400 Added mpi_utility module and other global reduction (gather) calls