scalegrd.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.                          *
! *********************************************************************
      IMPLICIT NONE
      INTEGER, PARAMETER ::  double = selected_real_kind(p=14,r=30)
      real(kind=double), allocatable :: x(:),y(:),z(:)
      INTEGER, allocatable :: blockdims(:,:)
      character*50 infile,outfile
      real(kind=double) scalefactor
      INTEGER numblocks, numnodes, blocks, i, j, k
      
      Write(*,*) "**********************************************************"
      Write(*,*) "This program is designed to take a GRIDGEN-generated text"
      Write(*,*) "grid file (.grd), and multiply every x, y, and z in the "
      Write(*,*) "file by a uniform factor. It was written to translate a "
      Write(*,*) "grid in millimeters to one in meters. "      
      Write(*,*) "**********************************************************"

      write(*,*)'Enter Input File Name:'
      read(*,*)infile
      write(*,*)'Enter Output File Name:'
      read(*,*)outfile
      write(*,*)'Enter Multiplicative Scale Factor for all x,y,z:'
      read(*,*)scalefactor

      open(unit=10,file=infile,form='formatted',action="read")
      open(unit=11,file=outfile,form='formatted',action="write")
          
          WRITE(*,*) "Ready to read numBlocks"
      READ(10,*) numblocks
          WRITE(*,*) "numblocks = ", numblocks
      allocate (blockdims(numblocks, 3))
          
          WRITE(*,*) "Read block dimensions."
      do blocks = 1, numblocks
         READ(10,*) blockdims(blocks, 1), blockdims(blocks, 2), blockdims(blocks, 3)
      enddo
          
          WRITE(*,*) "Write new block header in new file."
      WRITE(11,102) numblocks
      do blocks = 1, numblocks
         WRITE(11,102) blockdims(blocks, 1), blockdims(blocks, 2), blockdims(blocks, 3)
      enddo
          
          WRITE(*,*) "Read and write block data."
      do blocks = 1,numblocks
            
         WRITE(*,*) "Processing block:", blocks, " out of ", numblocks, " block(s)"
            
         numnodes = blockdims(blocks, 1)*blockdims(blocks, 2)*blockdims(blocks, 3)
            
         allocate (x(numnodes), y(numnodes), z(numnodes))
            
         READ(10,*) (x(i), i=1, numnodes)
         READ(10,*) (y(j), j=1, numnodes)
         READ(10,*) (z(k), k=1, numnodes)
           
         WRITE(11,101) (x(i)*scalefactor, i=1, numnodes)
         WRITE(11,101) (y(j)*scalefactor, j=1, numnodes)
         WRITE(11,101) (z(k)*scalefactor, k=1, numnodes)
            
         DEALLOCATE(x, y, z)

      enddo

      close (10)
      close (11)   

101   format(4(es19.11))
102   format(i8, 1x, i8, 1x, i8)

      stop
      end