c$debug
c
c    program to enter CRISIS parameters and put in CRISIS paramter files
c    program reads a CRISIS parameter file, optionally edits it
c    and writes out a new
c
c    jh jan 95
c    mar 24 95 by jh: fix bugs
c    jun 12         : --------
c
      implicit none
      character*40 text(100)     ! description of parameters
      character*80 title         ! general title of each parameter set
      real par(200)              ! parameters
      character*60 par_text(200) ! pameters as text, e.g files
      character*80 file_att      ! file name, attenuation input file
      character*80 file_cri      ! file name, crisis input
	  character*80 outfile       ! ----------------  output
      real tx                    ! value used as flag if parameter is text
      integer npar               ! number of parameters
      integer choise             ! choise of parameter set to enter
      integer natt_model_file    ! number of attenuation models in file
      integer natt_model
      integer nordinate_file     ! number of ordinates ----------------
      integer nordinate
	  character*1 answer
      integer nregion_file       ! number of regions in file
      integer nregion
      integer out                ! 0 not output, 1: output
      integer k,i
      logical finish
      common tx,title,finish
      tx=-9999.9
	  out=1                      ! assume output initially
      finish=.false.             ! assume all sets changed
c
 1    continue
      write(6,'(a,$)')' Set parameters for CRIATT (1) or CRISIS (2): '
      read(5,*,err=1) choise
      if(choise.ne.1.and.choise.ne.2) then
        write(6,*)' Wrong input'
        goto 1
      endif
c
      if(choise.eq.2) goto 1000
c
c   set defaults and text for criatt
c
      call set_att(text,par,npar)
      write(6,*) 
     *' Enter filename for input attenuation file, return for no file'
      read(5,'(a)') file_att
      if(file_att(1:5).ne.'     ') then      
         call read_att(file_att,par,npar)
      endif
c
c  edit parameters
c
      call get_par(npar,text,par,par_text)
c
c   write attenuation pars
c
      call write_att(file_att,par,npar)
c
      stop
c
c---------------------------------------------------------------------
c  section crisis
c---------------------------------------------------------------------
c
 1000 continue
c
c   set defs for 1. parameter set
c
      call set_cri1(text,par,npar,par_text)
c
      write(6,*) 
     *' Enter filename for CRISIS input file, return for no file'
      read(5,'(a)') file_cri
      if(file_cri(1:5).ne.'     ') then      
         call read_cri1(file_cri,par,npar,par_text)
c
c   save number of models and number of ordinates in original file, 
c   might change
c        
         natt_model_file=int(par(3))
         nordinate_file=int(par(4))
         nregion_file=int(par(2))
      endif
c
 5    continue
      write(6,*)' File name for output CRISIS parameter file,',
     *' return for no output'
      read(5,'(a)') outfile
      if(outfile(1:3).eq.'   ') then
         out=0
		 goto 20
      endif
      open(2,file=outfile,status='new',err=10)
	  goto 20
 10   continue
      write(6,*)' File already exists, overwrite(y/n)'
      read(5,'(a)') answer
      if(answer.eq.'y'.or.answer.eq.'Y') then
          open(2,file=outfile,status='unknown')
      else
          goto 5
      endif
 20   continue

c
c   edit parameters
c
      call get_par(npar,text,par,par_text)
c
c   check some of the parameters
c
      if(par(3).lt.1)  par(3)=1
      if(par(4).lt.1)  par(4)=1
      if(par(2).lt.1)  par(2)=1
      natt_model=int(par(3))
      nordinate=int(par(4))
      nregion=int(par(2))
c
c  write out
c
      call write_cri1(par,npar,par_text,out)
c      
c   one or several sets of spectral ordinates, the last entered value counts
c
      do k=1,nordinate
c
c   set defs for ordinates
c
         call set_cri2(text,par,npar,par_text)
         write(title(59:60),'(i2)') k           ! indicate which set
c
c   read from file which could contain more or less sets than
c   now wanted, if more, they are lost
c
         if(file_cri(1:5).ne.'     ') then      
            if(k.le.nordinate_file) 
     *      call read_cri2(file_cri,par,npar)
         endif
c
c   edit parameters
c
         call get_par(npar,text,par,par_text)
         call write_cri2(par,npar,out)
      enddo
c
c   if there were more parameter sets in file than now desired, read them
c
      if(nordinate_file.gt.nordinate) then
         do i=nordinate,nordinate_file-1
            call read_cri2(file_cri,par,npar)
         enddo
      endif
c
c   continue with more crisis parameters
c
c
c   set defs for 3. parameter set
c
      call set_cri3(text,par,npar,par_text)
c
      if(file_cri(1:5).ne.'     ') then      
         call read_cri3(file_cri,par,npar)
      endif
c
c   edit parameters
c
      call get_par(npar,text,par,par_text)
      call write_cri3(par,npar,out)
c
c   attenuation files
c
      npar=natt_model
      call set_cri_att(text,par,npar,par_text)
      if(file_cri(1:5).ne.'     ') then
         do i=1,natt_model_file
            read(7,'(a)') par_text(i)
         enddo
      endif
      call get_par(npar,text,par,par_text)
      if(out.ne.0) write(2,'(a)')(par_text(i),i=1,npar)
c
c--------------------------------------------------------------------
c   set defs for  parameters for each region 
c---------------------------------------------------------------------
c
      do k=1,nregion

         call set_cri4(text,par,npar,par_text)
         write(title(59:60),'(i2)') k
c
c   read from file which could contain more or less sets than
c   now wanted, if more, they are lost and will no tbe read.
c
         if(file_cri(1:5).ne.'     ') then      
            if(k.le.nregion_file) 
     *      call read_cri4(file_cri,par,npar,par_text)
         endif
c
c   edit parameters
c
         call get_par(npar,text,par,par_text)
         call write_cri4(par,npar,par_text,out)
c
c   set defs for model types, two possible
c
         if(par(2).eq.1) then
            call set_cri_poi(text,par,npar)
         else
            call set_cri_cha(text,par,npar)
         endif
         write(title(59:60),'(i2)') k
c
         if(file_cri(1:5).ne.'     ') then      
            if(k.le.nregion_file)
     *      call read_cri5(file_cri,par,npar)
         endif
c
c   edit parameters
c
          call get_par(npar,text,par,par_text)
          call write_cri5(par,npar,out)
      enddo
      close(2)      
      stop
      end
c
c
      subroutine get_par(npar,text,par,par_text)
c
c   get parameters
c
c     npar:   number of parameters
c     text:   text of parameter
c     par:    the parameter
c
c     
      implicit none
      real par(*)
      character*60 par_text(*)
      character*40 text(*)
      character*80 title
      character*80 chr_string   ! input for paramter #
      real sei real num         ! function to get real number from string
      integer code              ! errro code for ------
      real tx
      integer npar
      logical finish
      integer i,k,k1,k2,iscreen,nscreen
      common tx,title,finish
c
c   if no change, return
c
      if(finish) return
c
c   find number of screens needed to show all
c
      nscreen=npar/18+1
      iscreen=1
      k1=-17
c
  1   continue
c
c   start loop to enter parameters
c
      k1=k1+18
      k2=k1+17
      if(k2.gt.npar) k2=npar

  5   continue
c
c   write general title
c
      write(6,*)
      write(6,'(1x,a)') title
      write(6,*)
      do k=k1,k2
        if(par(k).eq.tx) then    ! a text entry
           write(6,'(1x,i2,2x,a,a)') k,text(k)(1:20),par_text(k)
        else
           write(6,'(1x,i2,2x,a,a,f9.3)') 
     *     k,text(k),' Value is: ',par(k)
        endif
      enddo
      write(6,*)
 10   continue
      write(6,'(a,a,$)')
     *'Parameter number to change, x to exit, return',
     *' for next parameter set '
      read(5,'(a)',err=10) chr_string
      if(chr_string(1:1).eq.'x'.or.chr_string(1:1).eq.'X') then
         finish=.true.
         return
      endif
      if(chr_string(1:2).eq.'  ') goto 30
      i=int(sei real num(chr_string,code)) 
      if(i.gt.k2) then
         write(6,*)' Number too large'
         goto 5
      endif
      if(i.lt.k1) then
         write(6,*)' Number too small'
         goto 5
      endif
 20   continue
      if(par(i).eq.tx) then
         write(6,'(a,a,a)')' Give a new value for ',text(i),'  '
         read(5,'(a)') par_text(i)
      else
         write(6,'(a,a,a$)')' Give a new value for ',text(i),'  '
         read(5,*,err=20) par(i)
      endif
      goto 5
c
 30   continue
      iscreen=iscreen+1
      if(iscreen.le.nscreen) goto 1         ! another screen
c
c  
      return
      end
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
      subroutine set_att(text,par,npar)
c
c   set values for attenuation
c
      implicit none
      character*40 text(*)
      integer npar
      real tx
      character*80 title
      real par(*)
      call blank
      title='Attenuation model parameters'
c
      text(1)= 'source model type (1=omega**2)          '
      par(1)=1
      text(2)= 'stress drop (bars)                      '
      par(2)=100.0
      text(3)= 'attenuation Q0                          '
      par(3)=500.0
      text(4)= 'epsilon (Q = Q0 * f exp(epsilon))       '
      par(4)=1.0
      text(5)= 'shear wave velocity (cm/sec)            '
      par(5)=3.5
      text(6)= 'density (g/cm*cm)                       '
      par(6)=2.7
      text(7)= 'high frequency decay factor (Kappa0)    '
      par(7)=0.025
      text(8)= 'high frequency decay factor (Kappa1)    '
      par(8)=0
      text(9)= 'moment magnitude (Mw)                   '
      par(9)=4.0
      text(10)='minimum site to source distance (km)    '
      par(10)=20.0
      text(11)='site factor g(f)                        '
      par(11)=2.0
      text(12)='duration coefficient (td)               '
      par(12)=0.05
      text(13)='minimum distance, Rmin (km)             '
      par(13)=10.0
      text(14)='maximum distance, Rmax (km)             '
      par(14)=600
      text(15)='minimum magnitude, Mmin                 '
      par(15)=4.0
      text(16)='maximum magnitude, Mmax                 '
      par(16)= 7.0
      text(17)='minimum structural period (sec)         '
      par(17)=0.005
      text(18)='maximum structural period (sec)         '
      par(18)=2.5
      text(19)='number of points between Rmin and Rmax  '
      par(19)=10
      text(20)='number of points between Mmin and Mmax  '
      par(20)=10
      text(21)='number of structural periods eq.sp.per  '
      par(21)=1
      text(22)='st. dev. of the structural periods (n)  '
      par(22)=0.7
      text(23)='st. dev. of the structural periods (n+1)'
      par(23)=0.7
      npar=23

c
      return
      end
c
c     
      subroutine read_att(file_att,par,npar)
c
c read attenuation file
c
      implicit none
      real par(*)
      character*80 file_att
      integer npar,i
c
c  assume npar is 23
c
      npar=23
      open(1,file=file_att,status='old',err=20)
      goto 19
 20   continue
      write(6,*)' No such file'
      stop
 19   continue
c
      read(1,*,err= 1) (par(i),i=1,npar)
      close(1)
      goto 2
 1    continue
      write(6,*)' Something wrong with attenuation file'
      stop
 2    continue
      return
      end
c
      subroutine write_att(file_att,par,npar)
c
c write attenuation file
c
      implicit none
      real par(*)
      character*80 outfile
	  character*1 answer
      character*80 file_att
      integer npar,i
c
 5    continue
      write(6,*)' File name for output attenuation file,',
     *' return for no output'
      read(5,'(a)') outfile
	  if(outfile(1:2).eq.' ') stop
      open(1,file=outfile,status='new',err=10)
      goto 20
 10   continue
      write(6,*)' File already exists, overwrite(y/n)'
      read(5,'(a)') answer
      if(answer.eq.'y'.or.answer.eq.'Y') then
          open(1,file=outfile,status='unknown')
      else
          goto 5
      endif
 20   continue
c
      write(1,'(i8)') int(par(1))
      write(1,'(10f8.3)') (par(i),i=2,11)
      write(1,'(f8.3)') par(12)
      write(1,'(6f8.3)') (par(i),i=13,18)
      write(1,'(3i8)') (int(par(i)),i=19,21)
      write(1,'(2f8.3)') par(22),par(23)
      close(1)
      return
      end
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc	  
      subroutine write_cri1(par,npar,par_text,out)
c
c read attenuation file
c
      implicit none
      real par(*)
      character*80 outfile
	  character*1 answer
      character*80 file_att
      character*60 par_text(*)
      integer npar,i,out
	  if(out.eq.0) return
c      out=1                        ! normally write out, if 0 no
c
c
      write(2,'(a)') par_text(1)
      write(2,'(5i5)') (int(par(i)),i=2,6)
      return
      end
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine write_cri2(par,npar,out)
c
c
      implicit none
      real par(*)
      integer npar,i,out
      if(out.eq.0) return
c
      write(2,'(3f8.1,2f8.3)') (par(i),i=1,5)
      return
      end
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine write_cri3(par,npar,out)
c
c 
c
      implicit none
      real par(*)
      integer npar,i,out
      if(out.eq.0) return
c
      write(2,'(2f8.3,f8.1,4f8.3)') (par(i),i=1,7)
      write(2,'(4f8.3,2i8)')
     *(par(i),i=8,11),(int(par(i)),i=12,13)
      return
      end
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine write_cri4(par,npar,par_text,out)
c
c 
c
      implicit none
      real par(*)
      character*60 par_text(*)
      integer npar,i,out
      if(out.eq.0) return
      write(2,'(a)') par_text(1)
      write(2,'(4i5)') (int(par(i)),i=2,5)
      write(2,'(6f8.2)') (par(i),i=6,11)
c
      return
      end
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine write_cri5(par,npar,out)
c
c 
c
      implicit none
      real par(*)
      integer npar,i,out
      if(out.eq.0) return
c
      write(2,'(9f8.3)') ((par(i)),i=1,9)
      return
      end
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
      subroutine set_cri1(text,par,npar,par_text)
c
c   set values for crisis, first 5 parameters and title
c
      implicit none
      character*40 text(*)
      character*80 title
      character*60 par_text(*)
      integer npar
      real tx
      real par(*)
      common tx,title
      call blank
c
      title(1:44)=
     *'Crisis parameters: Title and first 5 global parameters'
      text(1)= 'general title                           '
      par_text(1)='Seismic hazard of Africa'
      par(1)=tx           
      text(2)='# of earthquake source zones             '
      par(2)=2
      text(3)='# of attenuation models (i.e. tables)    '
      par(3)=1
      text(4)='# of spectral ordinates to be computed   '
      par(4)=2
      text(5)='# of levels of intensity (e.g. for PGA)  '
      par(5)=10
      text(6)='# of mag.intervals for re-interpolation  '
      par(6)=10
      npar=6
c
      return
      end
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine set_cri2(text,par,npar,par_text)
c
c   set values for crisis, spectral oridinate parameters
c
      implicit none
      character*40 text(*)
      character*60 par_text(*)
      character*80 title
      integer npar
      real tx
      real par(*)
      common tx,title
c
      call blank
      title(1:47)='Crisis parameters: Spectral ordinates for set #'
      text(1)='structural period (in sec)              '
      par(1)=0.0
      text(2)='min. intensity level (e.g.for PGA)      '
      par(2)=20
      text(3)='max. intensity level                    '
      par(3)=3500
      text(4)='median of Z (for hazard it must be 1)   '
      par(4)=1
      text(5)='st.dev.of Z (must be ca.zero if MZ is 1)'
      par(5)=0.001
      npar=5
      return
      end
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine set_cri3(text,par,npar,par_text)
c
c   set values for crisis, global parameters
c
      implicit none
      character*40 text(*)
      character*80 title
      character*60 par_text(*)
      integer npar
      real tx
      real par(*)
      common tx,title
      call blank
      title(1:36)='Crisis parameters: Global parameters'
      text(1)='discount rate (per year)                '
      par(1)=0.05
      text(2)='magnitude interval used in integrals    '
      par(2)=0.1
      text(3)='max. distance for hazard computation(km)'
      par(3)=2500.0
      text(4)='COEFK cost parameter,not used for hazard'
      par(4)=2.8
      text(5)='COEFA:cost parameter,not used for hazard'
      par(5)=1.2
      text(5)='COEFU:cost parameter,not used for hazard'
      par(6)=0
      text(7)='COEFQ:cost par. (must be zero if hazard)'
      par(7)=0
      text(8)='latitude of the grid origin             '
      par(8)=-15.0
      text(9)='longitude of the grid origin            '
      par(9)=26.0
      text(10)='latitude increment                      '
      par(10)=2.0
      text(11)='longitude increment                     '
      par(11)=2.0
      text(12)='# of grids in latitude                  '
      par(12)=8
      text(13)='# of grids in longitude                 '
      par(13)=9
      npar=13
      return
      end
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine set_cri_att(text,par,npar,par_text)
      implicit none
      character*40 text(*)
      character*80 title
      integer npar
      real tx
      real par(*)
      character*60 par_text(*)
      common tx,title
      call blank

      title(1:45)=
     *'Crisis parameters: Names of attenuation files'
      text(1)='1. attenuation file                     '
      par(1)=tx
      par_text(1)='atten.001'

      text(2)='2. attenuation file                     '
      par(2)=tx
      par_text(2)='atten.002'

      text(3)='3. attenuation file                     '
      par(3)=tx
      par_text(3)='atten.003'

      text(4)='4. attenuation file                     '
      par(4)=tx
      par_text(4)='atten.004'

      text(5)='5. attenuation file                     '
      par(5)=tx
      par_text(5)='atten.005'

      text(6)='6. attenuation file                     '
      par(6)=tx
      par_text(6)='atten.006'

      text(7)='7. attenuation file                     '
      par(7)=tx
      par_text(7)='atten.007'

      text(8)='8. attenuation file                     '
      par(8)=tx
      par_text(8)='atten.008'

      text(9)='9. attenuation file                     '
      par(9)=tx
      par_text(9)='atten.009'
      return
      end
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine set_cri4(text,par,npar,par_text)
c
c   set values for crisis, grid points
c
      implicit none
      character*40 text(*)
      character*80 title
      integer npar
      real tx
      real par(*)
      character*60 par_text(*)
      common tx,title
      call blank
      title(1:54)=
     *'Crisis parameters: Data defining seimicity in region #'
      text(1)='title of region                         '
      par(1)=tx
      par_text(1)='title of region'
      text(2)='flag, 1: Poisson, 2: characteristic eq. '
      par(2)=1
      text(3)='flag for intermediate results,0:no 1:yes'
      par(3)=0
      text(4)='attenuation model # for this source      '
      par(4)=1
      text(5)='# of cells to subdivide source (max.3x3) '
      par(5)=3
      text(6)='latitude of the source centre point      '
      par(6)=-6.0
      text(7)='longitude of the source centre point     '
      par(7)=30.0
      text(8)='source size in latitude (in degrees)     '
      par(8)=4.0
      text(9)='source size in longitude (in degrees)    '
      par(9)=1.0
      text(10)='depth of the source (in km)             '
      par(10)=10.0
      par(11)=0.0
      text(11)='source inclination angle (deg)          '
      par(10)=0.0
      npar=11
      return
      end
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine set_cri_poi(text,par,npar)
c
c   set values for crisis, grid points
c
      implicit none
      character*40 text(*)
      character*80 title
      integer npar
      real tx
      real par(*)
      common tx,title
      call blank
      title(1:54)=
     *'Crisis parameters: Poisson model for region #             '
      text(1)='# of earthq. > treshold magnitude       '
      par(1)=100
      text(2)='catalogue time span (in years)          '
      par(2)=100
      text(3)='beta (ln10 * b-value)                   '
      par(3)=2.3
      text(4)='coefficient of variation for beta       '
      par(4)=0.0
      text(5)='# of probability concentrations (max.5) '
      par(5)=1.0
      text(6)='maximum expected magnitude              '
      par(6)= 7.0
      text(7)='st.dev. of maximum expected magnitude   '
      par(7)=0.2
      text(8)='maximum observed magnitude              '
      par(8)=6.5
      text(9)='threshold magnitude                     '
      par(9)=4.0
      npar=9
      return
      end
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine set_cri_cha(text,par,npar)
c
c   set values for crisis, grid points
c
      implicit none
      character*40 text(*)
      character*80 title
      integer npar
      real tx
      real par(*)
      common tx,title
      call blank
      title(1:54)=
     *'Crisis parameters: Characteristic earthq.model for region  #'
      text(1)='return period of char.eq. (CE) (median) '
      par(1)=30
      text(2)='st.dev. of natural log of above         '
      par(2)=0.3
      text(3)='time elapsed since last occurence of CE '
      par(3)=15
      text(4)='maximum time in integration             '
      par(4)=99
      text(5)='slip predictable model parameter 1      '
      par(5)=5.36
      text(6)='slip predictable model parameter 2      '
      par(6)= 0.621
      text(7)='st.dev. of the magnitude of CE          '
      par(7)=0.3
      text(8)='minimum possible magnitude for CE       '
      par(8)=7.0
      text(9)='maximum possible magnitude for CE       '
      par(9)=8.5
      npar=9
      return
      end
c
      subroutine read_cri1(file_cri,par,npar,par_text)
c
c read file
c
      implicit none
      real par(*)
      character*60 par_text(*)
      real tx
      character*80 file_cri,title
      integer npar,i
      common tx,title

c
      open(7,file=file_cri,status='old',err=20)
      goto 19
 20   continue
      write(6,*)' No such file'
      stop
 19   continue
c
      read(7,'(a)') par_text(1)
      par(1)=tx   ! indicate text
      read(7,*,err=30)(par(i),i=2,6)
      goto 40
  30  continue
      write(6,*)' Something wrong with CRISIS input file'
      stop
  40  continue
      npar=6
      return
      end
c
      subroutine read_cri2(file_cri,par,npar)
c
c read file
c
      implicit none
      real par(*)
      real tx
      character*80 file_cri,title
      integer npar,i
      common tx,title
c
c   assume file opened in read_cri1
c
c
      read(7,'(5f8.3)',err=30)(par(i),i=1,5)
      goto 40
  30  continue
      write(6,*)' Something wrong with CRISIS input file'
      stop
  40  continue
      npar=5
      return
      end
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine read_cri3(file_cri,par,npar)
c
c read file
c
      implicit none
      real par(*)
      real tx
      character*80 file_cri,title
      integer npar,i,i2,i3
      common tx,title
c
c   assume file opened in read_cri1
c
c
      read(7,'(7f8.3)',err=30)(par(i),i=1,7)
      read(7,'(4f8.3,2i8)',err=30)(par(i),i=8,11),i2,i3
      par(12)=i2
      par(13)=i3 
      goto 40
  30  continue
      write(6,*)' Something wrong with CRISIS input file'
      stop
  40  continue
      npar=13
      return
      end
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine read_cri4(file_cri,par,npar,par_text)
c
c read file
c
      implicit none
      real par(*)
      character*60 par_text(*)
      real tx
      character*80 file_cri,title
      integer npar,i
      common tx,title
c
c   assume file opened in read_cri1
c
c
      read(7,'(a)') par_text(1)
      par(1)=tx
      read(7,*,err=30)(par(i),i=2,5)
      read(7,'(6f8.2)',err=30)(par(i),i=6,11)
      goto 40
  30  continue
      write(6,*)' Something wrong with CRISIS input file'
      stop
  40  continue
      npar=11
      return
      end
c
      subroutine read_cri5(file_cri,par,npar)
c
c read file
c
      implicit none
      real par(*)
      real tx
      character*80 file_cri,title
      integer npar,i
      common tx,title
c
c   assume file opened in read_cri1
c
c
      read(7,'(9f8.3)',err=30)(par(i),i=1,9)
      goto 40
  30  continue
      write(6,*)' Something wrong with CRISIS input file'
      stop
  40  continue
      npar=9
      return
      end

      subroutine blank
      real tx
      character*80 title
      common tx,title
      do i=1,80
        title(i:i)=' '
      enddo
      return
      end
