get_stats.f

Go to the documentation of this file.

!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
!                                                                      C
!  Module name: GET_STATS(IER)                                         C
!  Purpose: Get statistics for stalled or diverged iterations          C
!                                                                      C
!  Author: M. Syamlal                                 Date: 11-FEB-97  C
!  Reviewer:                                          Date:            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:                                               C
!                                                                      C
!  Variables modified:                                                 C
!                                                                      C
!  Local variables:  None                                              C
!                                                                      C
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
!
      SUBROUTINE get_stats()
!...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 physprop
      USE geometry
      USE fldvar
      USE indices
      USE funits
      USE residual
      USE run
      USE compar
      USE functions

      use machine

      IMPLICIT NONE
!-----------------------------------------------
!   G l o b a l   P a r a m e t e r s
!-----------------------------------------------
!-----------------------------------------------
!   L o c a l   P a r a m e t e r s
!-----------------------------------------------
!-----------------------------------------------
!   L o c a l   V a r i a b l e s
!-----------------------------------------------
!
!                      Indices
      INTEGER          I, J, K, IJK, M

      DOUBLE PRECISION tmp
!
!                      direction (1 - x, 2 - y, 3- z)
      INTEGER          Dir_g, Dir_s(dimension_m)
!
!                      Courant number
      DOUBLE PRECISION NC_g, NC_s(dimension_m)
!
!                      Maximum P_star
      DOUBLE PRECISION Ps
!
!                      Locations of maxima
      INTEGER          IJK_NC_g, IJK_Ps, IJK_NC_s(dimension_m)


!
!-----------------------------------------------

      dir_g = 1
      nc_g = large_number
      ijk_nc_g = 0
!
      ps = 0.
      ijk_ps = 0
!
      DO ijk = ijkmin1, ijkmax1
         IF (fluid_at(ijk)) THEN
            i = i_of(ijk)
            j = j_of(ijk)
            k = k_of(ijk)
!
            IF (u_g(ijk) == zero) THEN
               tmp = large_number
            ELSE IF (u_g(ijk) > zero) THEN
               tmp = dx(ip1(i))/u_g(ijk)
            ELSE
               tmp = -dx(i)/u_g(ijk)
            ENDIF
!
            IF (tmp < nc_g) THEN
               nc_g = tmp
               ijk_nc_g = ijk
               dir_g = 1
            ENDIF
!
            IF (v_g(ijk) == zero) THEN
               tmp = large_number
            ELSE IF (v_g(ijk) > zero) THEN
               tmp = dy(jp1(j))/v_g(ijk)
            ELSE
               tmp = -dy(j)/v_g(ijk)
            ENDIF
!
            IF (tmp < nc_g) THEN
               nc_g = tmp
               ijk_nc_g = ijk
               dir_g = 2
            ENDIF
!
            IF (w_g(ijk) == zero) THEN
               tmp = large_number
            ELSE IF (w_g(ijk) > zero) THEN
               tmp = dz(kp1(k))*x(i)/w_g(ijk)
            ELSE
               tmp = -dz(k)*x(i)/w_g(ijk)
            ENDIF
!
            IF (tmp < nc_g) THEN
               nc_g = tmp
               ijk_nc_g = ijk
               dir_g = 3
            ENDIF
!
            IF (p_star(ijk) > ps) THEN
               ps = p_star(ijk)
               ijk_ps = ijk
            ENDIF
!
         ENDIF
      END DO
      m = 1
      IF (mmax > 0) THEN
         dir_s(:mmax) = 1
         nc_s(:mmax) = large_number
         ijk_nc_s(:mmax) = 0
         m = mmax + 1
      ENDIF
      DO m = 1, mmax
         DO ijk = ijkmin1, ijkmax1
            IF (fluid_at(ijk)) THEN
               i = i_of(ijk)
               j = j_of(ijk)
               k = k_of(ijk)
               IF (u_s(ijk,m) == zero) THEN
                  tmp = large_number
               ELSE IF (u_s(ijk,m) > zero) THEN
                  tmp = dx(ip1(i))/u_s(ijk,m)
               ELSE
                  tmp = -dx(i)/u_s(ijk,m)
               ENDIF
!
               IF (tmp < nc_s(m)) THEN
                  nc_s(m) = tmp
                  ijk_nc_s(m) = ijk
                  dir_s(m) = 1
               ENDIF
!
               IF (v_s(ijk,m) == zero) THEN
                  tmp = large_number
               ELSE IF (v_s(ijk,m) > zero) THEN
                  tmp = dy(jp1(j))/v_s(ijk,m)
               ELSE
                  tmp = -dy(j)/v_s(ijk,m)
               ENDIF
!
               IF (tmp < nc_s(m)) THEN
                  nc_s(m) = tmp
                  ijk_nc_s(m) = ijk
                  dir_s(m) = 2
               ENDIF
!
               IF (w_s(ijk,m) == zero) THEN
                  tmp = large_number
               ELSE IF (w_s(ijk,m) > zero) THEN
                  tmp = dz(kp1(k))*x(i)/w_s(ijk,m)
               ELSE
                  tmp = -dz(k)*x(i)/w_s(ijk,m)
               ENDIF
!
               IF (tmp < nc_s(m)) THEN
                  nc_s(m) = tmp
                  ijk_nc_s(m) = ijk
                  dir_s(m) = 3
               ENDIF
!
            ENDIF
         END DO
      END DO
      CALL start_log
      IF(dmp_log)WRITE (unit_log, *) 'Gas phase:'
      IF(dmp_log)WRITE (unit_log, '(A, G12.3, A, I6, A, I1)') ' Minimum Courant No = ', &
         nc_g*odt, '  Location = ', ijk_nc_g, '  Direction = ', dir_g
!
      DO m = 1, mmax
         IF(dmp_log)WRITE (unit_log, '(A, I2, A)') ' Solids phase (', m, '):'
         IF(dmp_log)WRITE (unit_log, '(A, G12.3, A, I6, A, I1)') ' Minimum Courant No = '&
            , nc_s(m)*odt, '  Location = ', ijk_nc_s(m), '  Direction = ', &
            dir_s(m)
      END DO
      IF(dmp_log)WRITE (unit_log, '(A, G12.3, A, I6)') ' Maximum P_star = ', ps, &
         '  Location = ', ijk_ps
!
!      IF(DMP_LOG)WRITE(UNIT_LOG,'(A, G12.3, A, I6)')
!     & " Maximum P_g residual = ", MAX_RESID(RESID_P, 0),
!     & "  Location = ", IJK_RESID(RESID_P, 0)
!      IF(DMP_LOG)WRITE(UNIT_LOG,'(A, G12.3, A, I6)')
!     & " Maximum P_s residual = ", MAX_RESID(RESID_p, 1),
!     & "  Location = ", IJK_RESID(RESID_p, 1)
!
      IF(dmp_log)WRITE (unit_log, *)
!
      CALL end_log
!
      RETURN
      END SUBROUTINE get_stats

!// Comments on the modifications for DMP version implementation
!// 001 Include header file and common declarations for parallelization
!//? DO loop limits still running between IJKMIN1, IJKMAX1