creadSoftenPara.f

Go to the documentation of this file.

      subroutine creadsoftenpara(io)
      implicit none
      integer,intent(in):: io   ! logical dev. #
      character*24 vname
      character*100 vvalue


       call cskipsep(io)
       do while( cgetparmn(io, vname, vvalue ) )
          select case(vname)
          case('mode')
             call creadparai(vvalue, mode)
          case('xth') 
             call creadparar(vvalue, xth)
          case('E0th') 
             call creadparar(vvalue, e0th)
          case('fwbw')
             call creadparai(vvalue, fwbw)
          case('pw')
             call creadparar(vvalue, pw)
          case('repeat')
             call creadparar(vvalue, repeat)
          case('special')
             call creadparal(vvalue, special)
          case('leadingPiK')
             call creadparal(vvalue, leadingpik)
          case('useXinCMS')
             call creadparal(vvalue, usexincms)
          end select
       enddo
       end       subroutine creadsoftenpara
!      *************
       subroutine  cwritesoftenpara(io)
       implicit none
       integer,intent(in):: io

       write(io,*)'----------------------'
       call cwriteparai(io,'mode', mode)
       call cwriteparar(io,'xth', xth)
       call cwriteparar(io,'E0th', e0th)
       call cwriteparai(io,'fwbw', fwbw)
       call cwriteparar(io,'pw', pw)
       call cwriteparar(io,'repeat',repeat)
       call cwriteparal(io,'special',special)
       call cwriteparal(io,'leadingPiK',leadingpik)
       call cwriteparal(io,'useXinCMS', usexincms)
       end       subroutine  cwritesoftenpara


       subroutine cskipsep(io)
       implicit none
       integer io
       character(10)  sep
       do while (.true.)
          read(io, '(a)') sep
          if(sep(2:10) == '---------') exit
       enddo
       end  subroutine cskipsep
!        ************************* real*8 data
       subroutine creadparar(vvalue, x)
        implicit none
        integer io
        character*(*) vvalue
        real*8 x
!        read(vvalue, *)   x, x
        read(vvalue, *)   x
        end       subroutine creadparar
       subroutine creadparar2(vvalue, x, n)
        implicit none
        integer io
        character*(*) vvalue
        integer n
        real*8 x(n)
        read(vvalue, *)   x
        end       subroutine creadparar2

!     ************************* complex data
      subroutine creadparacx(vvalue, c)
      implicit none
      character*(*) vvalue
      complex*8 c
      read( vvalue, *)   c
      end      subroutine creadparacx
!     ************************ integer data
      subroutine creadparai(vvalue, i)
      implicit none
      character*(*) vvalue
      integer i
      read(vvalue, *)   i
      end      subroutine creadparai
!        ************************* character data
      subroutine creadparac(vvalue, cha)
      implicit none
      character*(*) vvalue
      character*(*) cha
      read(vvalue, *)  cha
      end      subroutine creadparac
!        ***************************** logical data
      subroutine creadparal(vvalue, logi)
      implicit none
      character*(*) vvalue
      logical logi
      read(vvalue, *)  logi
      end           subroutine creadparal
!        ---------------------------------------------
      subroutine cwriteparar(io, vname, x)
      implicit none
      integer io
      character*(*) vname
      real*8  x
      
      write(io, *) ' ', vname,' ', x,' /'
      end      subroutine cwriteparar
      subroutine cwriteparar2(io, vname, x, n)
      implicit none
      integer io
      integer n  ! arra size of x
      character*(*) vname
      real*8  x(n)
      
      write(io,*) ' ', vname,' ', x,' /'
      end      subroutine cwriteparar2

      subroutine cwriteparacx(io, vname, c)
      implicit none
      integer io
      character*(*) vname
      complex*8  c
      write(io,  *) ' ', vname,' ', c,' /'
      end subroutine cwriteparacx

      subroutine cwriteparai(io, vname, i)
      implicit none
      integer io
      character*(*) vname
      integer i
      
      write(io,  *) ' ', vname,' ', i,' /'
      end      subroutine cwriteparai

      subroutine cwriteparac(io, vname, cha)
      implicit none
      integer io
      character*(*) vname
      character*(*) cha
      integer klena
      character*2 qmk/" '"/             ! ' 
      if(klena(cha) .gt. 0) then
         write(io,  *) ' ', vname, qmk, cha(1:klena(cha)),
     *        qmk,' /'
      else
         write(io, *) ' ', vname, qmk, ' ', qmk, ' /'
      endif
      end      subroutine cwriteparac
      subroutine cwriteparal(io, vname, logi)
      implicit none
      integer io
      character*(*) vname
      logical  logi

      write(io,  *) ' ', vname,' ', logi,' /'
      end      subroutine cwriteparal

       function cgetparmn( io,  vname, vv ) result(ans)
!          get parameter variable name and given value(s)  from io
       implicit none
       integer io
       character*(*)  vname, vv  ! output
       logical ans

       integer linel
       parameter( linel = 100)
       character*(linel)  line
       integer loc, loc2
       vname = " "
       do while(.true.)
          read(io, '(a)', end=100 ) line
          if( line(1:1) .eq. " " .and. line(2:2) .ne. " ") then
             loc = index( line(3:linel), " ")  + 2
             vname = line(2:loc-1)
             loc2 = index( line, "/")
             if(loc2 .eq. 0 ) then
                write(0,* ) ' "/"  is missing in the input data file '
                write(0,*)  ' The line is: ', line
                stop 1234
             endif
             vv = line(loc+1:linel)  !  some data containes '/' such as '../../Media' so put all
                                     ! data.
             goto 50
          endif
       enddo
 50    continue
       ans = .true.
       return
 100   continue
       ans =.false.
       end function cgetparmn