utilities/RocfracPrep/readinp.f90

Go to the documentation of this file.

!*********************************************************************
!* Illinois Open Source License                                      *
!*                                                                   *
!* University of Illinois/NCSA                                       * 
!* Open Source License                                               *
!*                                                                   *
!* Copyright@2008, University of Illinois.  All rights reserved.     *
!*                                                                   *
!*  Developed by:                                                    *
!*                                                                   *
!*     Center for Simulation of Advanced Rockets                     *
!*                                                                   *
!*     University of Illinois                                        *
!*                                                                   *
!*     www.csar.uiuc.edu                                             *
!*                                                                   *
!* Permission is hereby granted, free of charge, to any person       *
!* obtaining a copy of this software and associated documentation    *
!* files (the "Software"), to deal with the Software without         *
!* restriction, including without limitation the rights to use,      *
!* copy, modify, merge, publish, distribute, sublicense, and/or      *
!* sell copies of the Software, and to permit persons to whom the    *
!* Software is furnished to do so, subject to the following          *
!* conditions:                                                       *
!*                                                                   *
!*                                                                   *
!* @ Redistributions of source code must retain the above copyright  * 
!*   notice, this list of conditions and the following disclaimers.  *
!*                                                                   * 
!* @ Redistributions in binary form must reproduce the above         *
!*   copyright notice, this list of conditions and the following     *
!*   disclaimers in the documentation and/or other materials         *
!*   provided with the distribution.                                 *
!*                                                                   *
!* @ Neither the names of the Center for Simulation of Advanced      *
!*   Rockets, the University of Illinois, nor the names of its       *
!*   contributors may be used to endorse or promote products derived * 
!*   from this Software without specific prior written permission.   *
!*                                                                   *
!* 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.                          *
!*********************************************************************
!* Please acknowledge The University of Illinois Center for          *
!* Simulation of Advanced Rockets in works and publications          *
!* resulting from this software or its derivatives.                  *
!*********************************************************************
SUBROUTINE readinp(ntime)
  
  USE meshdata
  
  IMPLICIT NONE
  
  INTEGER :: i
  INTEGER :: ntime

! -- local
  CHARACTER*200 :: keywd    ! keyword parameter
  INTEGER :: ios            ! io error

! -- Default

  numnodeio = 0
  ioformat = 1
  numvertx = 4
!
! -- Open Analysis Deck File

  OPEN(io_input,file='fractography3d.inp',status='old',iostat=ios)


  IF(ios.NE.0)THEN
     print*, 'Unable to find fractography3d.inp'
     print*, ' ...Trying RocfracControl.txt'
     
     OPEN(io_input,file='RocfracControl.txt',status='old',iostat=ios)
     IF(ios.NE.0)THEN
        print*, 'Unable to find RocfracControl.txt'
        print*, ' ...STOPPING'
        stop
     ENDIF
  ENDIF

!  CALL COM_call_system('mkdir -p Rocin')
!
! -- Read Analysis Deck File

  rewind io_input
10 READ(io_input,'(A)',iostat=ios) keywd
  IF(ios.LT.0) THEN ! Negative ios means end-of-file
     print*,' *END parameter not found - STOPPING'
     stop
  ENDIF
  IF(keywd(1:4).EQ.'*END') THEN
     goto 40
  ELSE IF(keywd(1:7).EQ.'*PREFIX') THEN
     CALL prefix_sub()
!!$     CALL system ('mkdir '//prefx(1:prefx_lngth))
     goto 10
  ELSE IF(keywd(1:7).EQ.'*MATVOL'.OR.keywd(1:13).EQ.'*HYPERELASTIC'.OR. &
       keywd(1:8).EQ.'*ELASTIC') THEN ! Read volumetric material props.
     CALL matvol_sub()
     goto 10  
  ELSE IF(keywd(1:8).EQ.'*ELEMENT'.AND.keywd(1:15).NE.'*ELEMENT OUTPUT')THEN
     CALL element_sub(keywd)
     goto 10
!      ELSE IF(keywd(1:5).EQ.'*NODE') THEN
!         CALL NODEIO_SUB()
!         GOTO 10
  ELSE IF(keywd(1:9).EQ.'*IOFORMAT') THEN
     CALL ioformat_sub()
     goto 10
  ELSE
     goto 10   
  ENDIF

40 READ(io_input,'(A)',iostat=ios) keywd
  IF(ios.LT.0) THEN ! Negative ios means end-of-file
     print*,' *END parameter not found - STOPPING'
     stop
  ENDIF
  IF(keywd(1:3).EQ.'*END') THEN
     goto 50
!      ELSE IF(keywd(1:3).EQ.'*BC') THEN
!         CALL BC_SUB()
!         GOTO 40
  ELSE IF(keywd(1:9).EQ.'*MESHSOFT') THEN
     CALL meshsoft_sub()
     goto 40
  ENDIF
50 CONTINUE

  CLOSE(io_input)

  RETURN
END SUBROUTINE readinp

SUBROUTINE prefix_sub()
  
  USE meshdata
  
  IMPLICIT NONE
  
  READ(io_input,'(a20)') prefx
  prefx_lngth = len_trim(prefx)
  
  RETURN
END SUBROUTINE prefix_sub

SUBROUTINE nrun_sub(ntime)
  
  USE meshdata
  
  IMPLICIT NONE
  
  INTEGER :: ntime,ii
  REAL*8 :: iaux
  READ(io_input,*) iaux, numvertx
  
  RETURN
END SUBROUTINE nrun_sub

SUBROUTINE matvol_sub()
  
  USE meshdata
  
  IMPLICIT NONE
  
  INTEGER :: i              ! loop counter
  
  INTEGER :: numat_vol      ! number of volumetric materials
  
  REAL*8 :: e, xnu, rho, alpha
  
  READ(io_input,*) numat_vol
  
  cd_fastest = 0.d0
  DO i = 1, numat_vol
     READ(io_input,*) e, xnu, rho, alpha
     cd_fastest = max( cd_fastest, &
          sqrt(e*(1.d0-xnu)/rho/(1.d0+xnu)/(1.d0-2.d0*xnu)) )
  ENDDO
  
  RETURN
END SUBROUTINE matvol_sub

SUBROUTINE bc_sub()
  
  USE meshdata
  
  IMPLICIT NONE
  
  INTEGER :: iaux
  INTEGER :: i
  
  DO i = 1, 32
     READ(io_input,*) iaux, bc_conditions(i)%b1, bc_conditions(i)%b2, bc_conditions(i)%b3, &
          bc_conditions(i)%bc1, bc_conditions(i)%bc2, bc_conditions(i)%bc3
  ENDDO
  
  RETURN
END SUBROUTINE bc_sub

SUBROUTINE nodeio_sub()
  
  USE meshdata
  
  IMPLICIT NONE
  
  INTEGER :: i              ! loop counter
  
  READ(io_input,*) numnodeio
  
  ALLOCATE(nodeio(1:numnodeio))
  
  DO i = 1, numnodeio
     READ(io_input,*) nodeio(i)
  ENDDO
  
  RETURN
END SUBROUTINE nodeio_sub

SUBROUTINE meshsoft_sub()
  
  USE meshdata
  
  IMPLICIT NONE
  
  CHARACTER*1 :: chr
  
  READ(io_input,*) chr
  
  iansys   = 0 ! set default -no-
  ipatran  = 0 
  itetmesh = 0
  ipatcohin   = 0
  itetcohin   = 0
  
  IF(chr.EQ.'T'.OR.chr.EQ.'t')THEN
     itetmesh = 1
  ELSE IF(chr.EQ.'A'.OR.chr.EQ.'a')THEN
     iansys = 1
  ELSE IF(chr.EQ.'P'.OR.chr.EQ.'p')THEN
     ipatran = 1
  ELSE IF(chr.EQ.'C'.OR.chr.EQ.'c')THEN
     READ(io_input,*) chr
     IF(chr.EQ.'P'.OR.chr.EQ.'p')THEN
        ipatcohin = 1
     ELSE IF(chr.EQ.'T'.OR.chr.EQ.'t')THEN
        itetcohin = 1
     ENDIF
  ELSE
     print*,' ERROR: MESHING PACKAGE NOT SUPPORTED'
     print*,'STOPPING'
     stop
  ENDIF
  
  RETURN
END SUBROUTINE meshsoft_sub

SUBROUTINE ioformat_sub()
  
  USE meshdata
  
  IMPLICIT NONE

! 0 = binary
! 1 = ascii

  READ(io_input,*) ioformat
  
  RETURN
END SUBROUTINE ioformat_sub
SUBROUTINE element_sub(keywd)
  
  USE meshdata
  
  IMPLICIT NONE
  
  CHARACTER(len=200) :: keywd
  INTEGER :: k1, k2
  
  CHARACTER(len=16) :: eltype
  
  CALL locchr(keywd,'TYPE                      ',4,8,k1,k2)
  
  eltype = keywd(k1:k2)
  
  SELECT CASE (trim(eltype))
  CASE ('V3D4')
     numvertx = 4
  CASE ('V3D4NCC')
     numvertx = 4
  CASE ('V3D4N')
     numvertx = 4
  CASE ('V3D10R')
     numvertx = 10
  CASE ('V3D10BBAR')
     numvertx = 10
  CASE ('V3D10')
     numvertx = 10
  CASE ('V3D8')
     numvertx = 8
  CASE ('V3D8ME')
     numvertx = 8
  CASE default
     print*,' ERROR:'
     print*,'*ELEMENT TYPE NOT FOUND'
     stop
  END SELECT
  RETURN
END SUBROUTINE element_sub