write_table.f

Go to the documentation of this file.

!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
!                                                                      C
!  Module name: WRITE_TABLE (LEGEND, ARRAY, DIST_MIN, LSTART, LEND)    C
!  Purpose: To write a table of DX, DY, DZ, and cell wall locations    C
!                                                                      C
!  Author: M. Syamlal                                 Date: 09-JAN-92  C
!  Reviewer: S. Venkatesan                            Date: 11-DEC-92  C
!                                                                      C
!  Revision Number:                                                    C
!  Purpose:                                                            C
!  Author:                                            Date: dd-mmm-yy  C
!  Reviewer:                                          Date: dd-mmm-yy  C
!                                                                      C
!  Literature/Document References:                                     C
!                                                                      C
!  Variables referenced: None                                          C
!  Variables modified: None                                            C
!                                                                      C
!  Local variables: NROW, L, L1, L2, L3, DIST, ARRAY1, ARRAY3          C
!                                                                      C
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
!
      SUBROUTINE write_table(LEGEND, ARRAY, DIST_MIN, LSTART, LEND)
!...Translated by Pacific-Sierra Research VAST-90 2.06G5  12:17:31  12/09/98
!...Switches: -xf
!
!-----------------------------------------------
!   M o d u l e s
!-----------------------------------------------
      USE param
      USE param1
      USE funits
      IMPLICIT NONE
!-----------------------------------------------
!   D u m m y   A r g u m e n t s
!-----------------------------------------------
!
!                      Legend
      CHARACTER(LEN=*)    LEGEND(3)
!
!                      DX, DY, or DZ Array to be written


!                      Starting array index
      INTEGER          LSTART
!
!                      Ending array index
      INTEGER          LEND
!//EFD Nov/11, avoid use of (*)
!//      DOUBLE PRECISION ARRAY(*)
      DOUBLE PRECISION ARRAY((lstart-1):(lend+1))
!
!                      Starting value of distance
      DOUBLE PRECISION DIST_MIN
!
!-----------------------------------------------
!   L o c a l   P a r a m e t e r s
!-----------------------------------------------
!
!                      Number of columns in the table.  When this is changed
!                      remember to change the FORMAT statement also.
      INTEGER, PARAMETER :: NCOL = 5
!
!                      Some dimension large enough for I, J, and K.
      INTEGER, PARAMETER :: DIMENSION_1 = max(dim_i, dim_j, dim_k)

!-----------------------------------------------
!   L o c a l   V a r i a b l e s
!-----------------------------------------------
!
!                      Indices
      INTEGER          ARRAY1(dimension_1)
!
!                      Array3 to be written
      DOUBLE PRECISION ARRAY3(dimension_1)
!
!                      Number of rows
      INTEGER          NROW
!
!                      Temporary storage for distance calculation
      DOUBLE PRECISION DIST
!
!                      Local array indices
      INTEGER          L, L1, L2, L3
!-----------------------------------------------
!
!
!  Fill arrays 1 and 3
!
      dist = dist_min
      DO l = lstart, lend
         array1(l) = l
         array3(l) = dist
         IF (l < lend) dist = dist + array(l+1)
      END DO
      nrow = (lend - lstart + 1)/ncol
!
      l2 = lstart - 1
      DO l = 1, nrow
         l1 = l2 + 1
         l2 = l1 + ncol - 1
         WRITE (unit_out, 1010) legend(1), (array1(l3),l3=l1,l2)
         WRITE (unit_out, 1020) legend(2), (array(l3),l3=l1,l2)
         WRITE (unit_out, 1030) legend(3), (array3(l3),l3=l1,l2)
      END DO
      IF (nrow*ncol < lend - lstart + 1) THEN
         l1 = l2 + 1
         l2 = lend
         WRITE (unit_out, 1010) legend(1), (array1(l3),l3=l1,l2)
         WRITE (unit_out, 1020) legend(2), (array(l3),l3=l1,l2)
         WRITE (unit_out, 1030) legend(3), (array3(l3),l3=l1,l2)
      ENDIF
      RETURN
!
 1010 FORMAT(7x,a3,2x,5(4x,i3,5x,1x))
 1020 FORMAT(7x,a3,2x,5(g12.5,1x))
 1030 FORMAT(7x,a3,2x,5(g12.5,1x),/)
      END SUBROUTINE write_table