      subroutine namepd
c        character compon*1
c        character*20 fmtx,titlx,fmtz,titlz,fmtg,titlg,fmth,titlh
c        character*56 bfile,mfile,gfile,hfile,ifmtg,ifmth,ofmtg,ofmth
        character*56 bfile,mfile,gfile,hfile
c        character*56 title1,title2,title3,cf
        character*56 cf
c        common /parm1/  nvert,nbody,nobs,mobs,iswt,jswt,
c     1               iave,jave,vex,istatn,iparsh,labelv,numbod
        common /magxyz/ ef(3),ev(3),tv(3),azmuth,icompn
        common /parms/ bfile,mfile,gfile,hfile,efield,einc,edec,iplotr,
     1                 iave,jave
c        common /plot1/  iplotr,sizea,sizet,sizel,
c     1          title1,title2,title3,
c     1          xscale,xxx(2),adelx,lintx,titlx,
c     1          zscale,zzz(2),adelz,lintz,titlz,
c     1          gscale,ggg(2),adelg,lintg,titlg,
c     1          hscale,hhh(2),adelh,linth,titlh
c        common /pltdev/ jplotr,xboard,yboard,xlimit,ylimit
c
c        prog='saki'
c        idum=0
c        ioutp=0
        test=' '
        mfile=' '
        bfile=' '
        gfile=' '
        hfile=' '
c        ifmtg=' '
c        ifmth=ifmtg
c        ofmtg='(1p3g15.5)'
c        ofmth=ofmtg
c        compon=' '
c        icompn=0
        efield=0.0
        einc=0.
        edec=0.
        iave=1
        jave=1
c        vex=1.0
c        xxx(1)=0.0
c        xxx(2)=0.0
c        istatn=1
c        iparsh=0
c        labelv=0
c        numbod=1
c        do 1 i=1,2000
c1       f(i)=0.
c        do 2 i=1,900
c2       p(i)=0.
c        nxf=0
c        nzf=0
c        nrf=0
c        call initp
c
109     print  110
110     format(' enter command filename :'$)
        read(5,37,end=109) cf
37	format(a20)
        if(cf.ne.test) then
          open (unit=9,file=cf,status='old',form='formatted')
          call namesk(9,*111)
          if(bfile(1:1).ne.' ') mfile=bfile
c          jfmtg=ifmtg
c          jfmth=ifmth
c          kfmtg=ofmtg
c          kfmth=ofmth
          ef(1)=efield
          ef(2)=einc
          ef(3)=edec
c          jplotr=iplotr
          go to 112
c111      print *,' there is either a syntax error in the command file'
c         print *,' or and invalid parameter.'
111       print *,' do you want a list of valid namelist parameters ?'
          if(noyes(ldum).eq.1) then
            print *,' mfile,gfile,hfile,ifmtg,ifmth,ofmtg,ofmth'
            print *,' iave,jave,efield,einc,edec,azmuth,compon,plenth'
            print *,' istatn,iparsh,labelv,numbod'
            print *,' iplotr,xlimit,ylimit,vex,sizea,sizet,sizel'
            print *,' title1*56,title2*56,title3*56'
            print *,' xscale,xxx(2),adelx,lintx,titlx*20'
            print *,' zscale,zzz(2),adelz,lintz,titlz*20'
            print *,' gscale,ggg(2),adelg,lintg,titlg*20'
            print *,' hscale,hhh(2),adelh,linth,titlh*20'
            print *,' note bfile has been changed to mfile'
          endif
          close(9)
          stop
112       close(9)
        endif
c        if(mfile.eq.test) then
c          write(*,114)
c114      format(' model filename: '$)
c          read(5,37) mfile
c        endif
c        if( gfile.eq.test) then
c          write(*,115)
c115      format(' gravity data filename (optional): '$)
c          read(5,37) gfile
c        endif
c        if(hfile.eq.test) then
c          write(*,116)
c116      format(' magnetic data filename (optional): '$)
c          read(5,37) hfile
c        endif
c
        return
        end
c******************************************************************************
      subroutine namesk(icmd,*)
c
c     namelist simulator for pc's with no namelist statement
c     this subroutine is program independent but it
c     calls subroutine check which is program dependent
c     The program does not handle the repeat indicator *
c     nor does it handle subscripted array variables or
c     substrings of character variables.
c     It also does not handle complex or logical variables.
c     nn = number of characters in value name(tvar)
c     chv = character variable indicator(logical)
c     inum = an array index number
c     nvar = a number returned by subroutine check to
c     determine whether a variable is an array
c     numa = a number returned by subroutine check
c     which is compared against nvar
c     r.godson,usgs,denver,co., 11/87
c
      parameter(ivar=80)
      character var(ivar),comma,apos,blank,equal,amp,dollar
      character*6 pvar
      character*56 tvar
      logical chv,vset
      data comma/','/,apos/#27/,blank/' '/,equal/'='/
      data amp/'&'/,dollar/'$'/,pvar/' '/,tvar/' '/
c
c     get namelist start name(e.g.&parms)
c
    5 read(icmd,1000,end=910) var
      do 7 i=1,ivar
      if(var(i).ne.amp.and.var(i).ne.dollar) go to 7
      do 6 m=i+1,ivar
      if(var(m).eq.blank) go to 15
    6 continue
    7 continue
      go to 5
c
c     start processing variables
c
   10 read(icmd,1000,end=900) var
 1000 format(80a1)
      m=1
   15 do 20 i=m,ivar
      if(var(i).eq.amp.or.var(i).eq.dollar) go to 900
      if(var(i).ne.blank.and.var(i).ne.comma) go to 30
   20 continue
      go to 10
   30 mm=0
c
c     check for continuation of array values on succeding lines
c
      item=ichar(var(i))
      if(item.eq.43.or.item.eq.45.or.item
     & .eq.46.or.(item.gt.47.and.item.lt.58).or.var(i).eq.apos) then
      k=i
      go to 95
      endif
c
c     get program variable name
c
   35 inum=1
      pvar=blank
      vset=.false.
      do 40 j=i,ivar
      if(var(j).eq.blank.or.var(j).eq.equal) go to 50
      mm=mm+1
      pvar(mm:mm)=var(j)
   40 continue
c
c     get variable value
c
     

   50 do 80 k=j+1,ivar
      if(var(k).eq.blank.or.var(k).eq.equal) go to 80
      if(var(k).eq.apos) then
c
c     character variable
      chv=.true.
      vset=.true.
      nn=0
      do 60 l=k+1,ivar
      if(var(l).eq.apos) go to 90
      nn=nn+1
      tvar(nn:nn)=var(l)
   60 continue
      write(*,*) 'error in namelist variable ',pvar,
     & ' no ending apostrophy'
      stop
      else
c
c     not a character variable
      chv=.false.
      nn=0
      do 70 l=k,ivar
      if(var(l).eq.blank.or.var(l).eq.comma
     & .or.var(l).eq.amp.or.var(l).eq.dollar) go to 90
c
c     check for non numeric character
c
      item=ichar(var(l))
      if((item.lt.48.and.(item.ne.46
     & .and.item.ne.45.and.item.ne.43)) .or. (item .gt. 57 .and.
     & (item .ne. 69 .and. item .ne. 101 .and. item.ne.68
     &  .and. item.ne.100))) then
      write(*,*) 'missing first apostropy or a non numeric',
     & ' character in namelist variable ',pvar
      stop
      endif
      nn=nn+1
      tvar(nn:nn)=var(l)
   70 continue
      write(*,*) 'error in namelist variable ',pvar,
     & ' no delimiter'
      stop
      endif
   80 continue
      write(*,*) 'error in namelist variable ',pvar,' no  value'
      stop
c
c     call program dependent subroutine to assign values
c
   90 call check(pvar,tvar,nn,chv,nvar,numa,inum,*920)
      tvar=blank
      k=l+1
c
c     check to see if variable is an array
c     the variable numa used is program dependent
c
      if(nvar.lt.numa) go to 110
   95 if(.not.chv) then
c
c     array variable
c
      nn=0
      do 100 l=k,ivar
      if(var(l).eq.blank.and.nn.eq.0) go to 100
      if(var(l-1).eq.blank.and.var(l).eq.comma.and.nn.eq.0) go to 100
      if((var(l).eq.amp.or.var(l).eq.dollar).and.nn.eq.0) go to 900
c
c     check for consecutive commas
c
      if(var(l).eq.comma.and.vset) then
      vset=.false.
      inum=inum+1
      go to 90
      else if(var(l).eq.comma) then
      inum=inum + 1
      go to 100
      endif
c
      if(var(l).eq.blank
     & .or.var(l).eq.amp.or.var(l).eq.dollar) then
      inum=inum+1
      go to 90
      endif
      if(ichar(var(l)).gt.57.and.nn.eq.0) go to 120
      nn=nn+1
      tvar(nn:nn)=var(l)
      vset=.true.
  100 continue
      else
c
c     character array variable
c
      do 105 j=k,ivar
      if(var(j).eq.blank) go to 105
      if(var(j).eq.amp.or.var(j).eq.dollar) go to 900
      if(ichar(var(j)).gt.57) then
      l=j
      go to 120
      endif
c
c     check for consecutive commas
c
      if(var(j).eq.comma.and.vset) then
      vset=.false.
      go to 105
      else if(var(j).eq.comma) then
      inum=inum + 1
      go to 105
      endif
      if(var(j).eq.apos) then
      nn=0
      inum=inum+1
      vset=.true.
      do 103 l=j+1,ivar
      if(var(l).eq.apos) go to 90
      nn=nn+1
      tvar(nn:nn)=var(l)
  103 continue
      write(*,*) 'error in namelist variable ',pvar,
     & ' no ending apostrophy'
      stop
      endif
  105 continue
c
c     end of array values
c
      endif
  110 m=l+1
      if(l.gt.80) go to 130
      if(var(l).eq.amp.or.var(l).eq.dollar) go to 900
      go to 130
  120 m=l
  130 if(m.lt.81) then
      go to 15
      else
      go to 10
      endif
  900 return
  910 write(*,*) ' error in namelist;no beginning & or $'
      stop
  920 return 1
      end
c*********
      subroutine check(pvar,tvar,nn,chv,nvar,numa,inum,*)
c
c     assigns values to proper variable
c     variables are passed to program saki through common blocks
c     numr=position in the array var where real variables start
c     numa=position in the array var where arrays start
c     nnvar=number of variables in program minc
c
      parameter(nnvar=50,numr=12)
      character*6 pvar,var(nnvar)
      character*56 tvar,kvar,cfmt
      logical chv
        character compon*1
c        character*20 fmtx,titlx,fmtz,titlz,fmtg,titlg,fmth,titlh
c        character*56 bfile,mfile,gfile,hfile,ifmtg,ifmth,ofmtg,ofmth
        character*56 bfile,mfile,gfile,hfile
c        character*56 title1,title2,title3
c        common /parm1/  nvert,nbody,nobs,mobs,iswt,jswt,
c     1               iave,jave,vex,istatn,iparsh,labelv,numbod
        common /magxyz/ ef(3),ev(3),tv(3),azmuth,icompn
        common /parms/ bfile,mfile,gfile,hfile,efield,einc,edec,iplotr,
     1                 iave,jave
c        common /parms/ bfile,mfile,gfile,hfile,ifmtg,ifmth,ofmtg,ofmth,
c     1 efield,einc,edec,compon,plenth
        common /plot1/  jplotr,sizea,sizet,sizel,
     1          title1,title2,title3,
     1          xscale,xxx(2),adelx,lintx,titlx,
     1          zscale,zzz(2),adelz,lintz,titlz,
     1          gscale,ggg(2),adelg,lintg,titlg,
     1          hscale,hhh(2),adelh,linth,titlh
c        common /pltdev/ jplotr,xboard,yboard,xlimit,ylimit
c
      data var/'iave','jave','istatn','iparsh','labelv','numbod',
     & 'iplotr','lintx','lintz','lintg','linth','efield','einc',
     & 'edec','azmuth','compon','plenth','xlimit','ylimit',
     & 'vex','sizea','sizet','sizel','bfile','mfile','gfile','hfile',
     & 'ifmtg','ifmth','ofmtg','ofmth','title1','title2',
     & 'title3','titlx','titlz','titlg','titlh','xscale',
     & 'zscale','gscale','hscale','adelx','adelz','adelg',
     & 'adelh','xxx','zzz','ggg','hhh'/
      numa=47
      do 190 i=1,nnvar
      if(pvar.ne.var(i)) go to 190
      if(.not.chv) then
c
c     noncharacter value
c     right justify then number in variable kvar
c
      m=57-nn
      im=m-1
      kvar(m:56)=tvar(1:nn)
      if(i.lt.numr) then
c
c     integer value
c
      write(cfmt,50) im,nn
   50 format('(',i2,'x,i',i2,')')
      read(kvar,cfmt) jvar
      else
c
c     real value
c
      write(cfmt,60) im,nn
   60 format('(',i2,'x,g',i2,'.0)')
      read(kvar,cfmt) xvar
      endif
      endif
      go to (101,102,103,104,105,106,107,108,109,110,111,112,
     & 113,114,115,116,117,118,119,120,121,122,123,124,1241,125,
     & 126,127,128,129,130,131,132,133,134,135,136,137,138,
     & 139,140,141,142,143,144,145,146,147,148,149),i
  101 iave=jvar
      go to 200
  102 jave=jvar
      go to 200
  103 istatn=jvar
      go to 200
  104 iparsh=jvar
      go to 200
  105 labelv=jvar
      go to 200
  106 numbod=jvar
      go to 200
  107 iplotr=jvar
      go to 200
  108 lintx=jvar
      go to 200
  109 lintz=jvar
      go to 200
  110 lintg=jvar
      go to 200
  111 linth=jvar
      go to 200
  112 efield=xvar
      go to 200
  113 einc=xvar
      go to 200
  114 edec=xvar
      go to 200
  115 azmuth=xvar
      go to 200
  116 compon=xvar
      go to 200
  117 plenth=xvar
      go to 200
  118 xlimit=xvar
      go to 200
  119 ylimit=xvar
      go to 200
  120 vex=xvar
      go to 200
  121 sizea=xvar
      go to 200
  122 sizet=xvar
      go to 200
  123 sizel=xvar
      go to 200
  124 bfile=tvar(1:nn)
      go to 200
 1241 mfile=tvar(1:nn)
      go to 200
  125 gfile=tvar(1:nn)
      go to 200
  126 hfile=tvar(1:nn)
      go to 200
  127 ifmtg=tvar(1:nn)
      go to 200
  128 ifmth=tvar(1:nn)
      go to 200
  129 ofmtg=tvar(1:nn)
      go to 200
  130 ofmth=tvar(1:nn)
      go to 200
  131 title1=tvar(1:nn)
      go to 200
  132 title2=tvar(1:nn)
      go to 200
  133 title3=tvar(1:nn)
      go to 200
  134 titlx=tvar(1:nn)
      go to 200
  135 titlz=tvar(1:nn)
      go to 200
  136 titlg=tvar(1:nn)
      go to 200
  137 titlh=tvar(1:nn)
      go to 200
  138 xscale=xvar
      go to 200
  139 zscale=xvar
      go to 200
  140 gscale=xvar
      go to 200
  141 hscale=xvar
      go to 200
  142 adelx=xvar
      go to 200
  143 adelz=xvar
      go to 200
  144 adelg=xvar
      go to 200
  145 adelh=xvar
      go to 200
  146 xxx(inum)=xvar
      go to 200
  147 zzz(inum)=xvar
      go to 200
  148 ggg(inum)=xvar
      go to 200
  149 hhh(inum)=xvar
      go to 200
  190 continue
      write(*,*) ' error in namelist - ',pvar,' variable not included'
      return 1
  200 nvar=i
      return
      end

