PLAG_ReadSolutionFilePost.F90

Go to the documentation of this file.

! *********************************************************************
! * Rocstar Simulation Suite                                          *
! * Copyright@2015, Illinois Rocstar LLC. All rights reserved.        *
! *                                                                   *
! * Illinois Rocstar LLC                                              *
! * Champaign, IL                                                     *
! * www.illinoisrocstar.com                                           *
! * sales@illinoisrocstar.com                                         *
! *                                                                   *
! * License: See LICENSE file in top level of distribution package or *
! * http://opensource.org/licenses/NCSA                               *
! *********************************************************************
! *********************************************************************
! * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,   *
! * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES   *
! * OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND          *
! * NONINFRINGEMENT.  IN NO EVENT SHALL THE CONTRIBUTORS OR           *
! * COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER       *
! * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,   *
! * Arising FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE    *
! * USE OR OTHER DEALINGS WITH THE SOFTWARE.                          *
! *********************************************************************
!******************************************************************************
!
! Purpose: read in PLAG solution pertaining to the main variable filed.
!
! Description: the following solution formats are supported:
!              - RocfloMP ASCII
!              - RocfloMP binary.
!
! Input: regions = dimensions of all regions.
!
! Output: region%levels%plag%cv        = conservative variables (current grid
!                                        level)
!         region%levels%plag%aiv       = auxilliary integer variables
!         region%levels%plag%arv       = auxilliary real variables
!
! Notes: only unsteady solution file format is supported.
!
!******************************************************************************
!
! $Id: PLAG_ReadSolutionFilePost.F90,v 1.4 2008/12/06 08:45:07 mtcampbe Exp $
!
! Copyright: (c) 2003 by the University of Illinois
!
!******************************************************************************

SUBROUTINE plag_readsolutionfilepost( regions )

  USE moddatatypes
  USE modpartlag, ONLY    : t_plag
  USE modbndpatch, ONLY   : t_patch
  USE moddatastruct, ONLY : t_region, t_level
  USE modglobal, ONLY     : t_global
  USE modinterfaces, ONLY : rflo_readdatafileint, rflo_readdatafilereal
  USE moderror
  USE modmpi
  USE modparameters
  USE plag_modparameters
  IMPLICIT NONE

! ... parameters
  TYPE(t_region), POINTER :: regions(:)

! ... loop variables
  INTEGER :: i, icont, ireg

! ... local variables
  CHARACTER(CHRLEN+17) :: fname
  CHARACTER(CHRLEN)    :: rcsidentstring, msg, timestring

#ifdef MPI
  INTEGER :: status(mpi_status_size)
#endif
  INTEGER, PARAMETER :: one = 1
  INTEGER :: bctype, errorflag, ilev, iregfile, n, n1, n2, naiv, narv, &
             ncont, ncv, ncvtile, ndimplag, ndimplagmax
  INTEGER, ALLOCATABLE, DIMENSION(:,:) :: aivfile, ivar
  INTEGER, POINTER,     DIMENSION(:)   :: pcvplagmass
  INTEGER, POINTER,     DIMENSION(:,:) :: paiv

  REAL(RFREAL), ALLOCATABLE, DIMENSION(:,:) :: arvfile, cvfile, dvfile, rvar
  REAL(RFREAL), POINTER,     DIMENSION(:,:) :: parv, pcv

  TYPE(t_patch),      POINTER :: ppatch
  TYPE(t_plag),       POINTER :: pplag
  TYPE(t_global),     POINTER :: global

!******************************************************************************

  rcsidentstring = '$RCSfile: PLAG_ReadSolutionFilePost.F90,v $ $Revision: 1.4 $'

  global => regions(1)%global

  CALL registerfunction( global,'PLAG_ReadSolutionFilePost',&
  'PLAG_ReadSolutionFilePost.F90' )

  IF (.NOT. global%plagUsed) goto 999

  IF ( global%myProcid == masterproc .AND. &
       global%verbLevel > verbose_none ) THEN
    WRITE(stdout,'(A,3X,A)') solver_name,'Reading PLAG solution file...'
  END IF ! global%verbLevel

! allocate fixed-size temporary data arrays -----------------------------------

  ALLOCATE( ivar(3,1),stat=errorflag )
  global%error = errorflag
  IF (global%error /= err_none) THEN
    CALL errorstop( global,err_allocate,__line__,'ivar' )
  END IF ! global%error

  ALLOCATE( rvar(1,1),stat=errorflag )
  global%error = errorflag
  IF (global%error /= err_none) THEN
    CALL errorstop( global,err_allocate,__line__,'rvar' )
  END IF ! global%error

! copy time to string ---------------------------------------------------------

  IF (global%flowType == flow_unsteady) THEN
    WRITE(timestring,'(1PE11.5)') global%timeStamp
  ELSE
    WRITE(timestring,'(1PE11.5)') 0._rfreal
  ENDIF

! open solution file (only master proc.) --------------------------------------

  IF (global%myProcid == masterproc) THEN

    IF (global%solutFormat == format_ascii) THEN
      WRITE(fname,'(A,1PE11.5)') &
       trim(global%inDir)//trim(global%casename)//'.plag_sola_',global%timeStamp
      OPEN(if_solut,file=fname,form='formatted',status='old',iostat=errorflag)
    ELSE IF (global%solutFormat == format_binary) THEN
      WRITE(fname,'(A,1PE11.5)') &
       trim(global%inDir)//trim(global%casename)//'.plag_solb_', global%timeStamp
      OPEN(if_solut,file=fname,form='unformatted',status='old',iostat=errorflag)
    ENDIF ! global%solutFormat

    global%error = errorflag
    IF (global%error /= err_none) THEN
      CALL errorstop( global,err_file_open,__line__,'File: '//trim(fname) )
    END IF ! global%error

  ENDIF   ! MASTERPROC

! read & check time stamp in file ----------------------------------------------

  IF (global%myProcid == masterproc) THEN
    CALL rflo_readdatafilereal( global,if_solut,global%solutFormat,1,1,rvar )
  ENDIF

#ifdef MPI
  IF ( global%nProcAlloc > 1 ) THEN
    CALL mpi_bcast( rvar,1,mpi_rfreal,masterproc,global%mpiComm,global%mpierr )
    IF (global%mpierr /= err_none) THEN
      CALL errorstop( global,err_mpi_trouble,__line__ )
    END IF ! global%mpierr
  ENDIF ! nProcAlloc
#endif

  IF (global%currentTime>0._rfreal) THEN
!    IF (global%currentTime /= rvar(1,1)) THEN
    IF (abs(global%currentTime-rvar(1,1))/global%currentTime > 1.0e-03_rfreal) THEN
      WRITE(msg,1000) rvar(1,1),global%currentTime
      CALL errorstop( global,err_time_solution, __line__,msg//' File: '//trim(fname) )
    ENDIF
  ENDIF

! read solution data ----------------------------------------------------------

  DO ireg=1,global%nRegions

! - get dimensions and pointers for PLAG datastructure

    ilev = regions(ireg)%currLevel

    ncont = regions(ireg)%plagInput%nCont
    naiv  = aiv_plag_last
    narv  = arv_plag_last
    ncv   = cv_plag_last+ncont

! - read region number and dimensions (only master)

    IF (global%myProcid == masterproc) THEN
      CALL rflo_readdatafileint( global,if_solut,global%solutFormat,2,1,ivar )
      iregfile  = ivar(1,1)
      ndimplag  = ivar(2,1)

      IF (iregfile /= ireg) &
        CALL errorstop( global,err_region_number,__line__,'File: '//trim(fname) )
    ENDIF ! global%myProcid

! - broadcast current value of nDimPlag to other processors

#ifdef MPI
    IF ( global%nProcAlloc > 1 ) THEN
      CALL mpi_bcast( ndimplag,1,mpi_integer,masterproc,global%mpiComm,global%mpierr )
      IF (global%mpierr /= err_none) THEN
        CALL errorstop( global,err_mpi_trouble,__line__ )
      END IF ! global%mpierr
    ENDIF ! nProcAlloca
#endif

    regions(ireg)%levels(ilev)%plag%nPcls = ndimplag

    ndimplagmax = regions(ireg)%plagInput%nPclsMax

    print*,'PLAG_readSolutionFilePost: iReg, nPcls,nPclsMax = ',ireg,ndimplag,ndimplagmax

    IF( ndimplag > ndimplagmax) THEN
      WRITE(*,*)'Increase Array size to fit Solution File'
      stop
    ENDIF ! nDimPlag

! - activate for number of particles greater than zero

    SELECT CASE (ndimplag)
      CASE (one:)

! -- master reads Aiv & sends data, others receive them

        IF (global%myProcid == masterproc) THEN

          ALLOCATE( aivfile(naiv,ndimplag),stat=errorflag )
          global%error = errorflag
          IF (global%error /= err_none) THEN
            CALL errorstop( global,err_allocate,__line__,'aivFile' )
          END IF ! global%error

          CALL rflo_readdatafileint(  global,if_solut,global%solutFormat, &
                                      naiv,ndimplag,aivfile )

#ifdef MPI
          IF (regions(ireg)%procid /= masterproc) THEN
            CALL mpi_send( aivfile,naiv*ndimplag,mpi_integer, &
                           regions(ireg)%procid,ireg, &
                           global%mpiComm,global%mpierr )
            IF (global%mpierr /= err_none ) THEN
              CALL errorstop( global,err_mpi_trouble,__line__ )
            END IF ! global%mpierr

          ENDIF ! regions(iReg)%procid
#endif

        ELSE ! not the master

          IF (regions(ireg)%procid == global%myProcid) THEN
            ALLOCATE( aivfile(naiv,ndimplag),stat=errorflag )
            global%error = errorflag
            IF (global%error /= err_none) THEN
              CALL errorstop( global,err_allocate,__line__,'aivFile' )
            ENDIF !global%error

#ifdef MPI
            CALL mpi_recv( aivfile,naiv*ndimplag,mpi_integer,masterproc,ireg, &
                           global%mpiComm,status,global%mpierr )
            IF (global%mpierr /= err_none) THEN
              CALL errorstop( global,err_mpi_trouble,__line__ )
            END IF ! global%mpierr
#endif
          END IF !regions(iReg)%procid

        END IF !global%myProcid

! -- copy solution into data structure

        IF (regions(ireg)%procid == global%myProcid) THEN
          pplag => regions(ireg)%levels(ilev)%plag
          paiv  => pplag%aiv

! -- copy nDimPlag to nPcls
          pplag%nPcls = ndimplag

          n=0
          DO i=1, ndimplag
            n = n+1
            paiv(aiv_plag_pidini,i) = aivfile(1,n)
            paiv(aiv_plag_regini,i) = aivfile(2,n)
            paiv(aiv_plag_regcrt,i) = aivfile(3,n)
            paiv(aiv_plag_icells,i) = aivfile(4,n)
            paiv(aiv_plag_indexi,i) = aivfile(5,n)
            paiv(aiv_plag_indexj,i) = aivfile(6,n)
            paiv(aiv_plag_indexk,i) = aivfile(7,n)
            paiv(aiv_plag_burnstat,i) = aivfile(8,n)
          ENDDO ! i
        END IF !regions(iReg)%procid

       IF (ALLOCATED(aivfile)) THEN
         DEALLOCATE( aivfile,stat=errorflag )
         global%error = errorflag
         IF (global%error /= err_none) THEN
           CALL errorstop( global,err_deallocate,__line__,'aivFile' )
         ENDIF ! global%error
       ENDIF ! aivFile

! -- master reads Arv & sends data, others receive them

       IF (global%myProcid == masterproc) THEN
         ALLOCATE( arvfile(narv,ndimplag),stat=errorflag )
         global%error = errorflag
         IF (global%error /= err_none) THEN
           CALL errorstop( global,err_allocate,__line__,'aivFile' )
         END IF ! global%error
         CALL rflo_readdatafilereal( global,if_solut,global%solutFormat, &
                                     narv,ndimplag,arvfile )

#ifdef MPI
         IF (regions(ireg)%procid /= masterproc) THEN
           CALL mpi_send( arvfile,narv*ndimplag,mpi_rfreal, &
                          regions(ireg)%procid,ireg, &
                          global%mpiComm,global%mpierr )
           IF (global%mpierr /= err_none ) THEN
             CALL errorstop( global,err_mpi_trouble,__line__ )
           END IF ! global%mpierr

         ENDIF ! regions(iReg)%procid
#endif

       ELSE ! not the master

         IF (regions(ireg)%procid == global%myProcid) THEN
           ALLOCATE( arvfile(narv,ndimplag),stat=errorflag )
           global%error = errorflag
           IF (global%error /= err_none) THEN
             CALL errorstop( global,err_allocate,__line__,'arvFile' )
           ENDIF !global%error

#ifdef MPI
           CALL mpi_recv( arvfile,narv*ndimplag,mpi_rfreal,masterproc,ireg, &
                          global%mpiComm,status,global%mpierr )
           IF (global%mpierr /= err_none) THEN
             CALL errorstop( global,err_mpi_trouble,__line__ )
           END IF ! global%mpierr
#endif
         END IF !regions(iReg)%procid

       END IF !global%myProcid

! -- copy solution into data structure

       IF (regions(ireg)%procid == global%myProcid) THEN
         pplag => regions(ireg)%levels(ilev)%plag
         parv => pplag%arv
         n=0
         DO i=1, ndimplag
           n = n+1
           parv(arv_plag_spload,i) = arvfile(1,n)
         ENDDO ! i
       END IF !regions(iReg)%procid

       IF (ALLOCATED(arvfile)) THEN
         DEALLOCATE( arvfile,stat=errorflag )
         global%error = errorflag
         IF (global%error /= err_none) THEN
           CALL errorstop( global,err_deallocate,__line__,'arvFile' )
         ENDIF ! global%error
       ENDIF ! arvFile

! -- master reads Cv & sends data, others receive them

       IF (global%myProcid == masterproc) THEN
         ALLOCATE( cvfile(ncv,ndimplag),stat=errorflag )
         global%error = errorflag
         IF (global%error /= err_none) THEN
           CALL errorstop( global,err_allocate,__line__,'cvFile' )
         END IF ! global%error

         CALL rflo_readdatafilereal( global,if_solut,global%solutFormat, &
                                     ncv,ndimplag,cvfile )

#ifdef MPI
         IF (regions(ireg)%procid /= masterproc) THEN
           CALL mpi_send( cvfile,ncv*ndimplag,mpi_rfreal, &
                          regions(ireg)%procid,ireg, &
                          global%mpiComm,global%mpierr )
           IF (global%mpierr /= err_none ) THEN
             CALL errorstop( global,err_mpi_trouble,__line__ )
           END IF ! global%mpierr

         ENDIF ! regions(iReg)%procid
#endif

       ELSE ! not the master

         IF (regions(ireg)%procid == global%myProcid) THEN
           ALLOCATE( cvfile(ncv,ndimplag),stat=errorflag )
           global%error = errorflag
           IF (global%error /= err_none) THEN
             CALL errorstop( global,err_allocate,__line__,'cvFile' )
           ENDIF !global%error

#ifdef MPI
           CALL mpi_recv( cvfile,ncv*ndimplag,mpi_rfreal,masterproc,ireg, &
                          global%mpiComm,status,global%mpierr )
           IF (global%mpierr /= err_none) THEN
             CALL errorstop( global,err_mpi_trouble,__line__ )
           END IF ! global%mpierr
#endif
         END IF !regions(iReg)%procid

       END IF !global%myProcid

! -- copy solution into data structure

       IF (regions(ireg)%procid == global%myProcid) THEN
         pplag => regions(ireg)%levels(ilev)%plag
         pcv         => pplag%cv
         pcvplagmass => pplag%cvPlagMass
         ncont = regions(ireg)%plagInput%nCont
         n=0
         DO i=1, ndimplag
           n = n+1
           pcv(cv_plag_xmom,i) = cvfile(1,n)
           pcv(cv_plag_ymom,i) = cvfile(2,n)
           pcv(cv_plag_zmom,i) = cvfile(3,n)
           pcv(cv_plag_ener,i) = cvfile(4,n)
           pcv(cv_plag_xpos,i) = cvfile(5,n)
           pcv(cv_plag_ypos,i) = cvfile(6,n)
           pcv(cv_plag_zpos,i) = cvfile(7,n)
           pcv(cv_plag_enervapor,i) = cvfile(8,n)
           DO icont = 1, ncont
            pcv(pcvplagmass(icont),i) = cvfile(cv_plag_last+icont,n)
           ENDDO ! iCont
         ENDDO ! i
       END IF !regions(iReg)%procid

       IF (ALLOCATED(cvfile)) THEN
         DEALLOCATE( cvfile,stat=errorflag )
         global%error = errorflag
         IF (global%error /= err_none) THEN
           CALL errorstop( global,err_deallocate,__line__,'cvFile' )
         ENDIF ! global%error
       ENDIF ! cvFile

    END SELECT ! nDimPlag
  ENDDO        ! iReg

! deallocate fixed-size temporary data arrays ---------------------------------

  DEALLOCATE( ivar,stat=errorflag )
  global%error = errorflag
  IF (global%error /= err_none) THEN
    CALL errorstop( global,err_deallocate,__line__,'ivar' )
  END IF ! global%error

  DEALLOCATE( rvar,stat=errorflag )
  global%error = errorflag
  IF (global%error /= err_none) THEN
    CALL errorstop( global,err_deallocate,__line__,'rvar' )
  END IF ! global%error

! finalize --------------------------------------------------------------------

  IF (global%myProcid == masterproc) THEN
    CLOSE(if_solut,iostat=errorflag)
    global%error = errorflag
    IF (global%error /= err_none) &
      CALL errorstop( global,err_file_close,__line__,'File: '//trim(fname) )
  ENDIF

999  CONTINUE
  CALL deregisterfunction( global )

1000 FORMAT('Time in file is= ',1pe12.5,' but it should be= ',e12.5,'.')

END SUBROUTINE plag_readsolutionfilepost

!******************************************************************************
!
! RCS Revision history:
!
! $Log: PLAG_ReadSolutionFilePost.F90,v $
! Revision 1.4  2008/12/06 08:45:07  mtcampbe
! Updated license.
!
! Revision 1.3  2008/11/19 22:18:18  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.2  2007/03/06 23:27:44  fnajjar
! Renamed nPclsTot to nPclsMax
!
! Revision 1.1  2004/12/01 22:00:46  fnajjar
! Initial revision after changing case
!
! Revision 1.3  2004/03/05 22:09:05  jferry
! created global variables for peul, plag, and inrt use
!
! Revision 1.2  2004/03/02 21:51:15  jferry
! Added output of vapor energy to rplagpost output file
!
! Revision 1.1.1.1  2003/05/06 16:14:38  fnajjar
! Import of postprocessing tool for Rocpart
!
!******************************************************************************