program list_maf1
c
c-----------------------------------------------------------------------
c Does an ASCII dump of the selected data from a RIMS maf1 file
c-----------------------------------------------------------------------
c      created:j. johnson
c      modified:h. waite v2.0
c      updated jfe johnson 10 may 82 corrections
c v2.1   jfej        15 aug 82 added subset for subperiods
c
c      16-jun-1993
c      the original version has some problems with some obscure modes
c      so this version was created to be modified as needed to print
c      the data as does the original lstmf1.
c      v1.0   rlwest   bcss
c-----------------------------------------------------------------------
c
      byte iopt,jc(4),kc(4)
      byte icode(2)
c-----------------------------------------------------------------------
      integer*2
iat(8),
iaz(8),
ical(8),
idat(2812),
ifxs(8),
iiz(8),
imdf(8),
imsf(8),
irag(8),
irdis(8),
irhv(8),
irhvf(8),
irpac(8),
irpf(8),
itr(8),
itt(8),
izag(8),
iz1dis(8),
iz2dis(8),
iz1hv(8),
iz2hv(8),
iz1hvf(8),
iz2hvf(8),
      integer*2
imsmd(32),
irpamd(32),
c-----------------------------------------------------------------------
       integer irpa(32),imsh(32)
      integer iw7(16,8)
      integer 
     3 ,iz2hv(8),iz1hv(8),irhv(8)
          integer iadef(6,8)
      integer kmsd(32,2,8),kmse(32,2,8),kmsf(32,2,8)
      integer ibfld(3,8),ibsc
      integer hder1(100)
      integer spnrt,spnang,rsa(512),pard(64),papz(64),pamz(64)
c-----------------------------------------------------------------------
      data jc/'s','h','f','d'/,kc/'s','h','f','d'/
      data icode/10,12/
c-----------------------------------------------------------------------
      common/mafblk/irec
      common/maf1/idat
c-----------------------------------------------------------------------
      equivalence (idat(1),hder1(1))
      equivalence (hder1(37),irpamd(1))
      equivalence (hder1(69),imsmd(1))
      equivalence (idat(125),iw7)
      equivalence (idat(101),ibfld)
c
      lun=1
      lunp=2
      lunin=5
      lunout=6
      call deluns(lun,lunin,lunout)
      write(lunout,2)
    2 format(' lstmf1 v2.1 ')
      call deopen
      open(unit=lunp,type='new',carriage control='list')
c
c
c terminal input
c
    5      write(lunout,51)
   51      format(' options - s=summary, h=headers , f=full list, d=dump',
     1      ' cntrl-z=exit')
      write(lunout,52)
   52      format($,' enter option ')
      read(lunin,53,end=99)iopt
   53      format(a1)
      if(iopt.gt.96)iopt=iopt-32
      jopt=0
      if(iopt.eq.jc(1))jopt=1
      if(iopt.eq.jc(2))jopt=2
      if(iopt.eq.jc(3))jopt=3
      if(iopt.eq.jc(4))jopt=4
      if(jopt.eq.0)go to 5
      ip=0
      if(jopt.eq.3.or.jopt.eq.4) ip=1
      call lmsset(kode)
      if(kode.lt.0)go to 98
      call subset(kode)
      if(kode.lt.0)go to 98
c
   10 continue
      call getmf1(ier)
      if(ier.eq.-10)go to 99
    8      call lmstst(kode)
      if(kode)10,20,90
   20      continue
      write(lunp,200) icode(ip+1),irec
  200 format(a1,'maf1 data record number ',i5)
      go to (30,40,50,60) jopt
c
c in limits so process
c
c
c
c      create summary listing
c
   30 call prtsum(lunp,hder1)
      go to 10
c
c      header only listing
c
   40 call prthed(lunp,hder1)
      call prtsr(lunp,hder1)
      go to 10
c
c      full listing
c
   50 continue
         call prthed(lunp,hder1)
      call prtsr(lunp,hder1)
      call prtmd(lunp,irpamd,imsmd)
      call w7flga(iw7,imdf,itr,iit,iiz,ical,ifxs,irpac,iat,
     1 iaz,izag,irag,iz2hv,iz1hv,irhv,iz2dis,iz1dis,irdis,
     2 irpf,imsf,iz2hvf,iz1hvf,irhvf)
      call defkms(iiz,iaz,itr,1,kmsd)
      call defkms(iiz,iaz,itr,2,kmse)
      call defkel(iit,iat,itr,kmsf)
      call detog(iiz,iaz,iit,iat,itr,iadef)
      ibsc=hder1(25)
      call refang(degsam,ramang)
      call angles(degsam,ramang,rsa)
      do 75 i=1,8
      call expmd1(imdf(i),ical(i),imsf(i),irpf(i),irpac(i),irpa,imsh)
c
c      the angles inserted in the following pitch angle calculations
c      depend on the location of the instrument on the s/c and may
c      be subject to change.for the definitions of the needed input
c      angles please see the papsm1 subroutine.
c
c
      call papsm1(ibfld(1,i),90.,30.,idat(20),pard)
      call papsm1(ibfld(1,i),0.,0.,idat(20),papz)
      call papsm1(ibfld(1,i),180.,0.,idat(20),pamz)
      do 75 j=1,2
      call prtsum(lunp,hder1)
      call prtwd7(lunp,iw7(1,i),imdf(i),itr(i),iit(i),iiz(i),ical(i),
     1 ifxs(i),irpac(i),iat(i),iaz(i),izag(i),irag(i),iz2hv(i),
     2 iz1hv(i),irhv(i),iz2dis(i),iz1dis(i),irdis(i),irpf(i),
     3 imsf(i),iz2hvf(i),iz1hvf(i),irhvf(i),iadef(1,i))
      call prtbfl(lunp,ibsc,ibfld(1,i))
      call prtdt1(lunp,i,j,irpa,imsh,kmsd(1,j,i),kmse(1,j,i),
     1 kmsf(1,j,i),rsa,pard,papz,pamz)
   75 continue
      go to 10
c
c      data dump
c
   60 call prtdat(lunp)
      go to 10
   90      continue
c end of current limits, update to new subperiod
      call lmsnxt(kode)
      if(kode.eq.0)go to 8
c other wise rewind and ask for new input
      call rewded
      go to 5
   99      write(lunout,500)
  500      format(' eof encountered')
      close(unit=lunp)
   98      call exit
      stop
      end


      subroutine prtmd(lun,irpa,imsh)
c
c      this subroutine prints out the appropriate values of the
c      rpa and ims settings for the beginning of the 8 second
c      record. the subroutine use the bits71,72&74 subroutine
c      to break out the word 7's .the appropriate flags are then
c      passed to subroutine expmod which decides whether the present
c      memory dump are to be used or whether default values are
c      correct.the correct rpa and ims values are put in vectors
c      irpa and imsh,resp. and then printed along with the proper
c      voltages and masses.
c                  parameters:
c                              lun=write unit number
c                              iw7=word 7 's
c
c      created: 11/4/81 h. waite
c      modified 10 may 82 jfej
c
c
      dimension irpa(32),imsh(32)
      byte ff
      data ff/12/
c
      write(lun,1) 
    1 format(/,15x,'rpa',30x,'ims',/,7x,'address',4x,'voltage',
     1 11x,'address',4x,'amu(hi)',3x,'amu(low)')
      do 20 k=1,32
      vrpa=irpa(k)*0.05
      vims=imsh(k)*0.54932+vrpa
      if(vims.gt.0.0) go to 5
      ihmn=0
      go to 10
    5 continue
      ihmn=7998.0/vims+0.5
   10 continue
      ilmn=(float(ihmn)+0.1)/4.0
      write(lun,2) irpa(k),vrpa,imsh(k),ihmn,ilmn
    2 format(8x,i4,6x,f5.2,13x,i4,i10,i11)
   20 continue
      write(lun,999) ff
  999 format(a1)
      return
      end


      subroutine prtwd7(lun,iw7,imdf,itr,iit,iiz,ical,ifxs,
     1 irpac,iat,iaz,izag,irag,iz2hv,iz1hv,irhv,iz2dis,iz1dis,
     2 irdis,irpf,imsf,iz2hvf,iz1hvf,irhvf,iadef)
c
c      this subroutine decodes the word 7 flags and monitonrs and
c      the prints the results for a given second of rims data.
c           parameters:
c               iw7=word 7's
c               imdf=memory dump flag
c               itr=toggle rate setting
c               iit=initial electrometer setting
c               iiz=initial z head setting
c               ical=calibration flag
c               ifxs=fixed scan flag
c               irpac=electrometer/ims flag
c               iat=alternate electrometer setting
c               iaz=alternate z head setting
c               izag=z aperture ground relay flag
c               irag=radial aperture ground relay flag
c               iz2hv=-z h.v. multiplier setting
c               iz1hv=+z h.v. multiplier setting
c               irhv=radial h.v. multiplier setting
c               iz2dis=-z discriminator setting
c               iz1dis=+z discriminator setting
c               irdis=radial discriminator setting
c               irpf=rpa memory mode flag
c               imsf=ims memory mode flag
c               iz2hvf=-z h.v. enable flag
c               iz1hvf=+z h.v. enable flag
c               irhvf=radial h.v. enable flag
c               iadef(1)=initial channel d setting
c               iadef(2)=alternate channel d setting
c               iadef(3)=initial channel e setting
c               iadef(4)=alternate channel e setting
c               iadef(5)=initial channel f setting
c               iadef(6)=alternate channel f setting
c
c        created: 11/4/81 h. waite
c
c
       integer*4 mcf(3),mcde(4),mtr(4),mrm(2),mim(2),mfg(2),mlv(2),
     1 mhv(4),mmd(2)
      integer iw7(16),iadef(6)
       byte ff
       data ff/12/
       data mcf/'rd','+z','-z'/
       data mcde/'+zl','+zh','-zl','-zh'/
       data mtr/'1/2','1/4','1/8','1/16'/
       data mrm/'read','zero'/
       data mim/'read','h/he'/
       data mlv/'low','high'/
       data mfg/'off','on'/
       data mmd/'ims','elec'/
       data mhv/'2100','2400','2800','1200'/
       apvm=iw7(14)*0.04000
       rvm=iw7(12)*0.27273+apvm
       vdc1m=iw7(8)*0.06000
       vdc2m=iw7(9)*0.02941
       vdc3m=iw7(10)*0.06667
       shvmrd=iw7(11)*9.0278
       shvmpz=iw7(13)*9.0278
       shvmmz=iw7(15)*9.0278
       hvrdm=iw7(5)*13.33333
       hvpzm=iw7(6)*13.33333
       hvmzm=iw7(7)*13.33333
       write(lun,2) mmd(irpac+1),irpac,mfg(imsf+1),imsf,
     1 rvm,iw7(12)
    2  format(2x,'instrument mode=',a4,'(',i1,')',
     1 11x,'memdump=',a3,'(',i1,')',6x,'rpa vol mon=',
     2 f6.2,'(',i3,')')
      write(lun,3) mrm(irpf+1),irpf,mfg(ical+1),ical,vdc1m,iw7(8)
    3 format(7x,'rpa memory=',a4,'(',i1,')',15x,'cal=',a3,'(',i1,
     1 ')',6x,'+12 vdc mon=',f6.2,'(',i3,')')
       write(lun,4) mim(imsf+1),imsf,mfg(irag+1),irag,vdc2m,iw7(9)
    4 format(7x,'ims memory=',a4,'('i1,')',5x,'rd ap grd rla=',
     1a3,'('i1')',7x,'+5 vdc mon=',f6.2,'('i3')')
      write(lun,5) mfg(ifxs+1),ifxs,mfg(izag+1),izag,vdc3m,iw7(10)
    5 format(7x,'fixed scan= ',a3,'('i1,')',6x,'z ap grd rla=',a3,
     1'('i1')',6x,'-12 vdc mon=',f6.2,'(',i3,')')
      write(lun,6) apvm,iw7(14)
    6 format(33x,'ap vol mon=',f4.1,'(',i3,')')
      write(lun,7) 
    7 format(//,16x,'channel !',4x,'d',3x,'!',4x,'e',3x,'!',
     1 3x,'f',4x,'!',/)
      write(lun,8)iiz,mcde(iadef(1)),iiz,mcde(iadef(3)),iit,
     1 mcf(iadef(5)),mtr(itr+1),itr
    8 format(16x,'initial !',2x,i1'/',a3,1x,'!',2x,i1'/',a3,1x,'!',2x,
     1i1,'/',a2,4x,'!',3x,'toggle rate=',a4,'sec (',i1,')')
       write(lun,9) iaz,mcde(iadef(2)),iaz,mcde(iadef(4)),iat,
     1 mcf(iadef(6))
    9  format(16x,'altrnte !',2x,i1,'/',a3,1x,'!',2x,i1,'/',
     1 a3,1x,'!',2x,i1,'/',a2,4x,'!')
      write(lun,10) 
   10 format(/,11x,'! cem hv',21x,'! ims hv',5x,'! discrm',/,6x,
     1'head ! swtch',3x,'settg',3x,'monitor',4x,'! monitor',4x,
     1'! setting')
      write(lun,11) mcf(1),mfg(irhvf+1),irhvf,irhv,mhv(irhv+1),
     1 iw7(5),hvrdm,iw7(11),shvmrd,mlv(irdis+1),irdis
   11 format(7x,a2,2x,'!',a3,'(',i1,')',1x,i1,'/',a4,'v',2x,i3,'/',
     1 f5.0,'v',2x,'!',i3,'/',f5.0,'v',2x,'!',a3,'(',i1,')')
      write(lun,11) mcf(2),mfg(iz1hvf+1),iz1hvf,iz1hv,mhv(iz1hv+1),
     1 iw7(6),hvpzm,iw7(13),shvmpz,mlv(iz1dis+1),iz1dis
      write(lun,11) mcf(3),mfg(iz2hvf+1),iz2hvf,iz2hv,mhv(iz2hv+1),
     1 iw7(7),hvmzm,iw7(15),shvmmz,mlv(iz2dis+1),iz2dis
      return
      end


      subroutine prtbfl(lun,ibsc,ibxyz)
c
c      this subroutine scales and prints the b field data in
c      one second intervals.
c           parameters:
c                 lun=write index
c                 bsc=b field scale factor
c                 ibxyz=b field x,y,z components
c
c       created: 11/4/81 h. waite
c
c
      integer ibxyz(3),ibsc
      integer*4 bxyz(3),ib
      do 10 i=1,3
      ib=ibxyz(i)
   10 bxyz(i)=ib*ibsc
      write(lun,20) ibsc,bxyz
   20 format(/,/,' bscale= ',i3,6x,' b field = ',3i10,' gamma')
      return
      end


      subroutine prtdt1(lun,i,j,irpa,imsh,kmsd,kmse,kmsf
     1 ,rsa,pard,papz,pamz)
c
c      this subroutine prints out the maf1 and performs the
c      necessary toggle deconvolution.
c      the printout is for 1/2s of data ie.one memory execution.
c                parameters:
c                      i=second counter for the 8s record
c                      j=1/2s mem exec counter (1 or 2)
c                      irpa=rpa addresses for the 1/2s
c                      imsh=ims addressses for the 1/2s
c                      kmsd=channel d toggle deconvolution
c                      kmsd=channel e toggle deconvolution
c                      kmsf=channel f toggle deconvolution
c                         rsa=ram angle of radial head
c                         pard=pitch angle of radial head
c                         papz=pitch angle of +z head
c                         pamz=pitch angle of -z head
c
c      created: 11/4/81 h. waite
c      pitch angles added:1/28/82 jhwjr
c
c
      integer irpa(32),imsh(32),kmsd(32),kmse(32),kmsf(32)
      integer rsa(512),pard(64),papz(64),pamz(64)
      common/maf1/idat(2812)
      integer*4 ztyp(5),etyp(4), mmsh, mmsl
      integer*4 idcodc,idrl,idrh,idd,ide,idf
      byte ff
      data ff/12/
      data ztyp/3h???,3h+zl,3h+zh,3h-zl,3h-zh/
      data etyp/2h??,2hrd,2h+z,2h-z/
      write(lun,1) 
 1    format(/,/,1x,'f#',4x,'rpa(v)',8x,'ims(amu)',11x,'radial cts',3x,
     $ 'rad angs',3x,
     $'electromtr',4x,'channel d',3x,'channel e','!',/,5x,'setg',1x,
     $'value',2x,'setg',6x,'value',33x,'hd counts',4x,'hd counts',3x,
     $'hd counts','!',/,25x,'l',7x,'h',6x,'low',3x,'high',
     $ 3x,'ram',1x,'pitch',38x,'+zpa',1x,'-zpa')
      do 10 k=1,32
           vrpa=float(irpa(k))*0.050
      vims=imsh(k)*0.54932+vrpa
      if(vims.gt.0.0) go to 3
      mmsh=0
      go to 4
    3 continue
      mmsh=7998.0/vims+0.5
    4 continue
      mmsl=(float(mmsh)+0.1)/4.0
           kmvd=kmsd(k)+1
           kmve=kmse(k)+1
           kmvf=kmsf(k)+1
      ijk=(i-1)*64+(j-1)*32+k
      jk=(j-1)*32+k
           iirl=252+ijk
           iirh=764+ijk
           iid=1788+ijk
           iie=2300+ijk
           iif=1276+ijk
      idrl=idcodc(idat(iirl),ic)
      idrh=idcodc(idat(iirh),ic)
      idd=idcodc(idat(iid),ic)
      ide=idcodc(idat(iie),ic)
      idf=idcodc(idat(iif),ic)
           write(lun,2) k,irpa(k),vrpa,imsh(k),mmsl,mmsh,idrl,
     $     idrh,rsa(ijk),pard(jk),etyp(kmvf),idf,ztyp(kmvd),idd,
     $     ztyp(kmve),ide,papz(jk),pamz(jk)
 2         format(1x,i2,2x,i4,1x,f5.2,2x,i4,1x,i6,2x,i6,1x,i6,1x,i6,2x,
     $     i4,1x,i4,4x,a2,1x,i6,3x,a3,1x,i6,2x,a3,1x,i6,
     $ 1x,i4,1x,i4)
 10   continue
      write(lun,999) ff
  999 format(a1)
      return
      end


      subroutine prtsr(lun,header)
c
c      this program simply prints the spin-phase angle of the
c      s/c velocity vector to the s/c +x-axis.
c
      integer header(100)
      spa=float(header(23))/10.0
      write(lun,10) spa
   10 format(' the angle between the s/c ram and the +x-axis is ',
     1 f6.1,' deg.')
      return
      end