write_ab_m_var.f

Go to the documentation of this file.

!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
!                                                                      C
!  Module name: Write_Ab_m_var(A_m, b_m, var, IER)                  C
!  Purpose: Write the sparse matrix coefficients and the               C
!           source vector.                                             C
!                                                                      C
!                                                                      C
!  Literature/Document References:                                     C
!                                                                      C
!  Variables referenced:                                               C
!  Variables modified:                                                 C
!                                                                      C
!  Local variables:                                                    C
!                                                                      C
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
!
      SUBROUTINE write_ab_m_var(A_M, B_M, VAR)
!...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 geometry
      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
!
!                      cell index
      INTEGER          IJK
!
!                      Septadiagonal matrix A_m
      DOUBLE PRECISION A_m(dimension_3, -3:3)
!
!                      Source vector
      DOUBLE PRECISION b_m(dimension_3)

!                      Source vector
      DOUBLE PRECISION var(dimension_3)

      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 '
         WRITE (*,*) ' 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     Variable'
      end if


      do l = -3,3

      call gather(a_m(:,l),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

      call gather(var(:),array1,root)
      call gather(b_m(:),array2,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(I,J,K)
      ijk = funijk_gl(imap_c(i),jmap_c(j),kmap_c(k))

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

      END DO
      END DO
      END DO

      if (mype == pe_io) CALL end_log


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

      RETURN
      END SUBROUTINE write_ab_m_var

!// 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