READ_HEADER.f90

Go to the documentation of this file.

!    Copyright (C) 2012 The SPEED FOUNDATION
!    Author: Ilario Mazzieri
!
!    This file is part of SPEED.
!
!    SPEED is free software; you can redistribute it and/or modify it
!    under the terms of the GNU Affero General Public License as
!    published by the Free Software Foundation, either version 3 of the
!    License, or (at your option) any later version.
!
!    SPEED is distributed in the hope that it will be useful, but
!    WITHOUT ANY WARRANTY; without even the implied warranty of
!    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
!    Affero General Public License for more details.
!
!    You should have received a copy of the GNU Affero General Public License
!    along with SPEED.  If not, see <http://www.gnu.org/licenses/>.
 
 
      subroutine read_header(headerfile,gridfile,matefile,mpifile,monfile,bkpfile,sdoffile, &   
                             time_step,start_time,stop_time,&
                             option_out_var,&          
                             trestart,&
                             ndt_monitor,&                
                             deltat_fixed,&                
                             depth_search_mon_pgm,ndt_mon_pgm,n_pgm,&        
                             rotation_angle_mon_pgm,monfile_pgm,&        
                             depth_search_mon_lst,n_lst,monfile_lst, &
                             depth_search_sys_lst,s_lst,sysfile_lst,&
                             dg_c,pen_c, scheme, order, stages, testmode, &
                             ntime_err, time_err, damping_type, &
                             n_testcase, tag_testcase, &
                             b_failoncoeffs, b_setuponly, b_failCFL, b_instabilitycontrol, instability_maxval)
 
      use speed_exit_codes
      use speed_sci, only : sdofout, flag_outatalldofs
 
      implicit none
      
      character*70 :: headerfile,gridfile,matefile,mpifile,monfile,bkpfile,sdoffile 
      character*70 :: inline
      character*10 :: scheme        
      character*8 :: keyword
      character*3 :: deltat_fixed        
 
      integer*4 :: testmode, trestart
      integer*4 :: status, dummy
      integer*4 :: ileft,iright, order, stages
      integer*4 :: arglen      
      integer*4 :: i,j,im,is
      integer*4 :: ndt_monitor                
      integer*4 :: ndt_mon_pgm,n_pgm                                
      integer*4 :: monfile_pgm                                        
      integer*4 :: n_lst, s_lst, ntime_err, itime, n_testcase, tag_testcase
      integer*4 :: monfile_lst, sysfile_lst, damping_type
      integer*4 :: file_row = 0
 
      integer*4, dimension (6) :: option_out_var 
 
      real*8 :: val,dg_c, pen_c
      real*8 :: time_step,start_time,stop_time
      real*8 :: depth_search_mon_pgm                                
      real*8 :: rotation_angle_mon_pgm                                
      real*8 :: depth_search_mon_lst, depth_search_sys_lst
 
 
      real*8, dimension(ntime_err) :: time_err
 
      ! If .TRUE., fails when a mandatory argument is missing
      logical :: b_fail_unset_args = .false.
 
      ! New settings
      ! Instability
      real*8 :: instability_maxval
      logical :: b_instabilitycontrol
      logical :: b_failoncoeffs, b_setuponly, b_failCFL
 
 
      im = 0;       is = 0;            itime = 0;
      n_pgm = 0;    monfile_pgm = 0                 
      n_lst = 0;    monfile_lst = 0   
      s_lst = 0;    sysfile_lst = 0;   sdofout = 0;   flag_outatalldofs = 0;
      n_testcase = 0;          
 
      time_err = 0      
 
 
      open(40,file=headerfile)
      
      do    
         read(40,'(A)',iostat = status) inline
         file_row = file_row + 1
         
         if (status.ne.0) exit
         
         ! Skip comments
         if (inline(1:1) .eq. ' ') then
            cycle
         endif
 
         !!!! Parse keyword arguments
         ileft = 1
         iright = len_trim(inline)
         
         ! Compute index to first non-keyword argument
         do i = 1,iright
            if (inline(i:i) .eq.' ') exit
         enddo
         ileft = i + 1
         keyword = inline(1:(ileft-2))
 
         ! Now ileft points after the first blank
         arglen = len_trim(inline(ileft:iright))
 
!         write(*,*) 'keyword=', keyword, '  inline= ', inline
!         write(*,*) 'ileft= ', ileft, '   iright= ', iright, '   arglen=', arglen
!         write(*,*) 'inline(ileft:iright)=', inline(ileft:iright)
!         write(*,*)
 
         ! Remove this for keywords without arguments!
         if (arglen .eq. 0) then
            write(*,'(A,I3,A,A,A)') 'FATAL in SPEED.input, row', file_row, ': no argument given for command "', trim(keyword), '"'
            call exit(exit_syntax_error)
         endif
 
!         write(*,*) 'Comparing ', inline(1:(ileft-2)), ', ileft=', ileft
 
         select case (keyword)
 
           case('GRIDFILE')
            read(inline(ileft:iright),*) gridfile
 
           case('DGMETHOD') 
            read(inline(ileft:iright),*) dg_c
 
           case('PENALIZC') 
            read(inline(ileft:iright),*) pen_c
         
           case('TIMESTEP')
            read(inline(ileft:iright),*) time_step
         
           case('STARTIME')
            read(inline(ileft:iright),*) start_time
         
           case('STOPTIME')
            read(inline(ileft:iright),*) stop_time
         
           case('RESTART')
            !is = is +1
            read(inline(ileft:iright),*) trestart
 
           case('TIMEFIXE')                                
            read(inline(ileft:iright),*) time_step                                        
            deltat_fixed = 'not'                                                        
 
           case('TMONITOR')                                        
            read(inline(ileft:iright),*) ndt_monitor                
            
           case('TIMESCHM') 
            read(inline(ileft:iright),*) scheme, order, stages
             
           case('TESTMODE') 
            testmode = 1    
 
           case('MATFILE')
            read(inline(ileft:iright),*) matefile
           
           case('MPIFILE')
            read(inline(ileft:iright),*) mpifile   
           
           case('MONFILE')
            read(inline(ileft:iright),*) monfile   
           
           case('BKPFILE')
            read(inline(ileft:iright),*) bkpfile   
 
           case('SDOFFILE')   !!! AH
            read(inline(ileft:iright),*) sdoffile      !!! location folder for sdof files    
 
           case('OPTIOUT')
            read(inline(ileft:iright),*) option_out_var(1),option_out_var(2),&  
                        option_out_var(3), option_out_var(4),option_out_var(5),option_out_var(6)
 
           case('SDOFOUT')  !!! AH
            read(inline(ileft:iright),*) flag_outatalldofs, sdofout(1),sdofout(2),sdofout(3)
                        
           case('TIMEERR') 
            itime = itime + 1                
            read(inline(ileft:iright),*) time_err(itime)  
 
           case('DAMPING')
            read(inline(ileft:iright),*) damping_type   
    
 
           case('PGDM')                                        
            n_pgm = 1                                                        
            read(inline(ileft:iright),*) depth_search_mon_pgm, &
                        ndt_mon_pgm,rotation_angle_mon_pgm,monfile_pgm                        
           
           case('MLST')                        
            n_lst = 1                                
            read(inline(ileft:iright),*) depth_search_mon_lst,monfile_lst
           
           case('SYSLST')   !!! AH
            s_lst = 1
            read(inline(ileft:iright),*) depth_search_sys_lst,sysfile_lst
            sysfile_lst = 0   
            !Sri - since we are applying SDOF reaction forces at nearest LGL node (on ground surface)
            ! Not allocating the SDOF inside any element now, 
            ! so we dont need SDOF coorinates in reference coordinates of consisting element
    
           case('TESTCASE')
            n_testcase = 1                                
            read(inline(ileft:iright),*) tag_testcase
    
           !! New flags
 
           case('FAILCFL')
            ! If specified as "FAILCFL T", quit if CFL condition does not hold
            read(inline(ileft:(ileft+arglen)),'(L)') b_failcfl
 
           case('FAILINST')
            ! If specified as "FAILINST T", enable instability control
            read(inline(ileft:iright),*) b_instabilitycontrol
 
           case('SETUPONL')
            ! If specified as "SETUPONL T", quit before starting the time loop
            read(inline(ileft:iright),*) b_setuponly
 
           case('FAILCOEF')
            ! If specified as "FAILCOEF T", quit if any of the computed
            ! anelastic coefficients is negative [damping 2]
            read(inline(ileft:iright),*) b_failoncoeffs
 
           case('INSTVAL')
            ! If specified, overwrite preset instability threshold
            read(inline(ileft:iright),*) instability_maxval
            !b_instabilitycontrol = .true.
 
           ! Ignored keywords (for compatibility)
           case('r_f')
            write(*,'(A,I3,A,A)') 'In SPEED.input, row', file_row, ': ignored field ', keyword
            
           case('DEBUG')
             read(inline(ileft:iright),*) dummy            
 
           ! Fail if keyword is not recognised
           case default
            write(*,'(A,I3,A,A)') 'FATAL in SPEED.input, row', file_row, ': unknown keyword ', keyword
            call exit(exit_syntax_error)
 
         end select  
 
      enddo
      
      
! Snapshots reordering
      
!      if (nsnapshots.gt.1) then
!         do i = 1,nsnapshots-1
!            do j = i+1, nsnapshots
!               if (t_snapshot(i).gt.t_snapshot(j)) then
!                  val = t_snapshot(i)
!                  t_snapshot(i) = t_snapshot(j)
!                  t_snapshot(j) = val
!               endif
!            enddo
!         enddo
!      endif
      
      close(40)
      
      return
      end subroutine read_header