C                                      *** BANK ***
C
C     SUBROUTINE TO PRINT DATA OR DICTIONARY ON THE LINE PRINTER.
C     OUTPUT IS SPOOLED AND ENTERED INTO THE PRINT QUEUE BY PRINTS
C
C
C AAR ==============================================================
C AAR
C AAR
C AAR			*** AAR UPDATES MADE BY W.E.BARKER ***
C AAR			*** 10/10/77 TO RUN ON DEC-20      ***
C AAR
C AAR	CHANGES: DONT PRINT BY CALLING THE "PRINTS" ROUTINE
C AAR		 (IT HANGS). INSTEAD, PRINT THE FILE BY
C AAR		 USING THE DISPOSE='LIST' OPTION OF THE 
C AAR		 CLOSE STATEMENT.
C AAR	
C AAR	NOTE: AAR CHANGES ARE IDENTIFIED BY "AAR" IN LEFT MARGIN
C AAR	      OF COMMENT LINE. ORIGINAL LINES THAT HAVE BEEN 
C AAR	      COMMENTED OUT ARE IDENTIFIED BY "WMU" IN THE LEFT
C AAR	      MARGIN.
C AAR
C AAR
C AAR ==============================================================
C
C
C
      SUBROUTINE PRINT
      DIMENSION LV(125),NNS(18,6),IOUT(133),LOUT(10),IFTOUT(24)
      DIMENSION X(3),ID(12500),D(12500),IADD(125),IWO(125)
      DIMENSION SOCSC(9),IFMT(24,25),IFT(120),AOUT(10),MOUT(8)
      EQUIVALENCE (LV,NNS),(D,ID),(MISS,AMISS),(IFT(90),IFTOUT)
      EQUIVALENCE (LOUT,AOUT)
      COMMON /GEN/ IPROJA,IPROGA,NV,NO,BNKNM,DATCR,NPROJR,NPROGR
      COMMON /DEV/ IDLG,ICC,IBNK,IUPGR,ITMPRY
      COMMON /VAR/ LICVR,NHV,IV(2,20)
      COMMON /OBS/ LICOB,NHO,IO(2,20)
      COMMON /SEL/ NS,ISEL(5,20),IDATA(20,20)
      COMMON /IDINFO/ LICID,LICIN,LICWO
      DOUBLE PRECISION BNKNM,DATCR,ISSEC,DATRN
      DATA MISS /"400000000000/
      CALL DATE(DATRN)
      OPEN(UNIT=IUPGR,DEVICE='DSK',FILE='PRINT.DAT',ACCESS='SEQOUT')
      NLPP=59
      NPAGE=1
      LINHD=0
      NUMBRV=0
      DO 101 I=1,NHV
101   NUMBRV=NUMBRV+IV(2,I)-IV(1,I)+1
      NUMBRV=NUMBRV+NS
      IF(NUMBRV.LE.200) GO TO 100
      WRITE(IDLG,99)
99    FORMAT(' NO MORE THAN 200 VARIABLES IN A PRINT INSTRUCTION')
      RETURN
100   LND=12500/NUMBRV-2
      IF(LND.GT.125) LND=125
      JND=LND+2
C
C
C
      IBLK=0
      J=1
      M=NS
      NOBASE=(NO+124)/125
      IBASE=NOBASE*NV+1
C
C     INFO HEADER
C
200   WRITE(IUPGR,113) DATRN,NPAGE
113   FORMAT('1BANK - WMU',10X,A9,93X,'PAGE ',I5)
      NPAGE=NPAGE+1
      NLINES=1
      IF(LICWO.EQ.1) GO TO 202
       READ(IBNK#1) LV
      WRITE(IUPGR,201) BNKNM,LV(1),LV(2),LV(4),LV(5),LV(6),LV(7)
201   FORMAT('0BANK ',A10,10X,' CONTAINS ',I5,' VARIABLES AND',
     1I6,' OBSERVATIONS, CREATED ON ',2A5/40X,O6,', ',O6,' IS ',
     2'RESPONSIBLE FOR ITS CONTENT')
      NLINES=NLINES+3
202   WRITE(IUPGR,203)
203   FORMAT('0',2X,' VARIABLE'/' NAME',3X,'NUMBER',3X,'MODE',
     15X,'DATA DESCRIPTION')
      NLINES=NLINES+3
      DO 205 J=1,NHV
      K=IV(1,J)
206   NBLK=(K+5)/6+IBASE
      M=M+1
      IF(NBLK.EQ.IBLK) GO TO 208
      READ(IBNK#NBLK) LV
      IBLK=NBLK
208   IONE=K-((K-1)/6)*6
      ID(M*JND)=NNS(10,IONE)
      ID(M*JND-1)=NNS(1,IONE)
      IF(NNS(1,IONE).NE.'SOCSC') GO TO 211
      IF(NNS(10,IONE).NE.2) GO TO 211
      IF(M.EQ.(NS+1)) GO TO 211
      DO 212 L=NS+1,M-1
      IF(ID(L*JND-1).NE.'SOCSC') GO TO 212
      WRITE(IDLG,213)
213   FORMAT(' SOCIAL SECURITY NUMBER MAY ONLY BE LISTED ONCE IN PRINT')
      RETURN
212   CONTINUE
211   MODE='FLOAT'
      IF(NNS(10,IONE).EQ.1) MODE='ALPHA'
      IF(NNS(10,IONE).EQ.2) MODE='FIXED'
      WRITE(IUPGR,209)NNS(1,IONE),K,MODE,(NNS(L,IONE),L=2,9)
209   FORMAT(1X,A5,2X,I4,5X,A5,4X,8A5)
      NLINES=NLINES+1
      IF(NLINES.LE.NLPP) GO TO 210
      WRITE(IUPGR,113) DATRN,NPAGE
      WRITE(IUPGR,203)
      NPAGE=NPAGE+1
      NLINES=4
210   K=K+1
      IF(K.LE.IV(2,J)) GO TO 206
205   CONTINUE
      IF(LICIN.EQ.1) GO TO 300
C
C
102   DO 103 I=1,NUMBRV-NS,8
      M=(I+7)/8
      K=I+7
      IF(K.GT.(NUMBRV-NS)) K=NUMBRV-NS
      DO 104 L=1,120
104   IFT(L)=' '
      IFT(1)='('
      IFT(2)='1'
      IFT(3)='0'
      IFT(4)='X'
      IFT(5)=','
      L=6
      IF(I.NE.1) GO TO 108
      IFT(2)=1H'
      IFT(3)='0'
      IFT(4)=1H'
      IFT(5)=','
      IFT(7)='I'
      IFT(8)='7'
      IFT(9)=','
      IFT(10)='2'
      IFT(11)='X'
      IFT(12)=','
      L=13
108   DO 105 J=I,K
      MM=ID((NS+J)*JND)
      IF(MM.NE.0) GO TO 106
      IFT(L)='G'
      IFT(L+1)='1'
      IFT(L+2)='4'
      IFT(L+3)='.'
      IFT(L+4)='7'
      IFT(L+5)=','
      IFT(L+6)='1'
      IFT(L+7)='X'
      IFT(L+8)=','
      L=L+9
      GO TO 105
106   IF(MM.NE.1) GO TO 107
      IFT(L)='5'
      IFT(L+1)='X'
      IFT(L+2)=','
      IFT(L+3)='A'
      IFT(L+4)='5'
      IFT(L+5)=','
      IFT(L+6)='5'
      IFT(L+7)='X'
      IFT(L+8)=','
      L=L+9
      GO TO 105
107   IF(MM.NE.2) PAUSE 'ERROR'
      IF(ID((NS+J)*JND-1).EQ.'SOCSC') GO TO 109
      IFT(L)='I'
      IFT(L+1)='1'
      IFT(L+2)='3'
      IFT(L+3)=','
      IFT(L+4)='2'
      IFT(L+5)='X'
      IFT(L+6)=','
      L=L+7
      GO TO 105
109   IFT(L)='A'
      IFT(L+1)='3'
      IFT(L+2)=','
      IFT(L+3)=1H'
      IFT(L+4)='-'
      IFT(L+5)=1H'
      IFT(L+6)=','
      IFT(L+7)='A'
      IFT(L+8)='2'
      IFT(L+9)=','
      IFT(L+10)=1H'
      IFT(L+11)='-'
      IFT(L+12)=1H'
      IFT(L+13)=','
      IFT(L+14)='A'
      IFT(L+15)='4'
      IFT(L+16)=','
      IFT(L+17)='4'
      IFT(L+18)='X'
      IFT(L+19)=','
      L=L+20
105   CONTINUE
      IFT(L-1)=')'
      ENCODE(120,110,IFMT(1,M)) IFT
110   FORMAT(132A1)
      IZERO=0
103   CONTINUE
      WRITE(IUPGR,113) DATRN,NPAGE
      NPAGE=NPAGE+1
      NLINES=1
      NLPO=(NUMBRV-NS+15)/8
      IF(LICWO.EQ.1) GO TO 111
      CALL HEADR(ID,NS,NUMBRV,JND,IOUT,IUPGR)
      NLINES=NLINES+NLPO+1
C
C     RETRIEVE AND CALCUALTE ADRESSES
C
111   I=1
120   K=IO(1,I)
      IBASE=(K+124)/125
      KK=(IBASE-1)*125
      N=1
121   IWO(N)=K-KK
      IADD(N)=K
      K=K+1
      IF(K.LE.IO(2,I)) GO TO 122
      I=I+1
      IF(I.GT.NHO) GO TO 124
      K=IO(1,I)
122   LBASE=(K+124)/125
      IF(LBASE.NE.IBASE) GO TO 123
      N=N+1
      IF(N.LE.LND) GO TO 121
      N=N-1
123   IO(1,I)=K
C
C     SELECT DATA
C
124   IF(NS.LT.1) GO TO 130
      DO 125 J=1,NS
      KK=(J-1)*JND
      LBLK=(ISEL(2,J)-1)*NOBASE+IBASE+1
      READ(IBNK#LBLK) LV
      DO 126 M=1,N
126   ID(KK+M)=LV(IWO(M))
125   CONTINUE
C
C     NOWDATA
C
130   L=NS
      DO 131 J=1,NHV
      K=IV(1,J)
132   LBLK=(K-1)*NOBASE+IBASE+1
      READ(IBNK#LBLK) LV
      KK=L*JND
      DO 133 M=1,N
133   ID(KK+M)=LV(IWO(M))
      L=L+1
      K=K+1
      IF(K.LE.IV(2,J)) GO TO 132
131   CONTINUE
C
C     NOW CHECK TO SEE WHAT SHOULD BE KEPT
C
      DO 149 J=1,N
      IF(NS.LT.1) GO TO 157
      K=1
140   LLN=(K-1)*JND+J
      IF(ISEL(3,K).NE.1) GO TO 141
      DO 144 M=1,ISEL(5,K)
      IF(IDATA(K,M).EQ.MISS) GO TO 143
144   CONTINUE
141   IF(ID(LLN).NE.MISS) GO TO 143
      GO TO 146
143   GO TO (151,152,153,154,155,156) ISEL(3,K)
151   DO 145 M=1,ISEL(5,K)
      IF(ID(LLN).EQ.IDATA(K,M)) GO TO 142
145   CONTINUE
      GO TO 146
152   IF(ID(LLN).LT.IDATA(K,1)) GO TO 142
      GO TO 146
153   IF(ID(LLN).LE.IDATA(K,1)) GO TO 142
      GO TO 146
154   IF(ID(LLN).GT.IDATA(K,1)) GO TO 142
      GO TO 146
155   IF(ID(LLN).GE.IDATA(K,1)) GO TO 142
      GO TO 146
156   IF(ID(LLN).NE.IDATA(K,1)) GO TO 142
      GO TO 146
146   K=K+1
      IF(K.GT.NS) GO TO 149
      IF(ISEL(1,K).EQ.ISEL(1,K-1)) GO TO 140
      GO TO 149
142   K=K+1
      IF(K.GT.NS) GO TO 157
      IF(ISEL(1,K).EQ.ISEL(1,K-1)) GO TO 142
      GO TO 140
C
C     OUTPUT NOW
C
157   IF((NLINES+NLPO).LE.NLPP) GO TO 165
      WRITE(IUPGR,113) DATRN,NPAGE
      NPAGE=NPAGE+1
      NLINES=1
      IF(LICWO.EQ.1) GO TO 165
      CALL HEADR(ID,NS,NUMBRV,JND,IOUT,IUPGR)
      NLINES=NLINES+NLPO+1
165   DO 160 K=NS+1,NUMBRV,8
      MM=(K-NS+7)/8
      KEND=K+7
      IF(KEND.GT.NUMBRV) KEND=NUMBRV
      MDAT=0
      M=0
      MZ=0
      DO 161 L=K,KEND
      MZ=MZ+1
      M=M+1
      MOUT(MZ)=0
      LOUT(M)=ID((L-1)*JND+J)
      IF(LOUT(M).NE.MISS) GO TO 169
      MDAT=1
      MOUT(MZ)=1
169   IF(ID(L*JND-1).NE.'SOCSC') GO TO 161
      IF(ID(L*JND).NE.2) GO TO 161
      ENCODE(9,167,ISSEC) LOUT(M)
167   FORMAT(I9)
      DECODE(9,168,ISSEC) SOCSC
168   FORMAT(9A1)
      LOUT(M)=' '
      LOUT(M+1)=' '
      LOUT(M+2)=' '
      ENCODE(3,168,LOUT(M))(SOCSC(KK),KK=1,3)
      ENCODE(2,168,LOUT(M+1))(SOCSC(KK),KK=4,5)
      ENCODE(4,168,LOUT(M+2))(SOCSC(KK),KK=6,9)
      M=M+2
161   CONTINUE
      DO 166 L=1,24
166   IFTOUT(L)=IFMT(L,MM)
      IF(MDAT.EQ.1) GO TO 162
      IF(K.NE.(NS+1)) WRITE(IUPGR,IFTOUT)(AOUT(KK),KK=1,M)
      IF(K.EQ.(NS+1)) WRITE(IUPGR,IFTOUT)IADD(J),(AOUT(KK),KK=1,M)
      GO TO 160
162   DO 158 L=1,133
158   IOUT(L)=' '
      IF(K.NE.(NS+1)) ENCODE(133,IFTOUT,IFT)(AOUT(KK),KK=1,M)
      IF(K.EQ.(NS+1)) ENCODE(133,IFTOUT,IFT) IADD(J),(AOUT(KK),KK=1,M)
      DECODE(133,163,IFT) IOUT
163   FORMAT(133A1)
      DO 164 L=1,KEND-K+1
      IF(MOUT(L).NE.1) GO TO 164
      M=11+(L-1)*15
      IOUT(M)=' '
      IOUT(M+1)='M'
      IOUT(M+2)='I'
      IOUT(M+3)='S'
      IOUT(M+4)='S'
      IOUT(M+5)='I'
      IOUT(M+6)='N'
      IOUT(M+7)='G'
      IOUT(M+8)=' '
      IOUT(M+9)='D'
      IOUT(M+10)='A'
      IOUT(M+11)='T'
      IOUT(M+12)='A'
      IOUT(M+13)=' '
      IOUT(M+14)=' '
164   CONTINUE
      WRITE(IUPGR,163) IOUT
160   CONTINUE
      NLINES=NLINES+NLPO
149   CONTINUE
      IF(I.LE.NHO) GO TO 120
C WMU
C WMU
C WMU 300   CALL RELEAS (IUPGR)
C WMU      NPAGE=NPAGE+3
C WMU      CALL PRINTS('PRINT.DAT',2,1,1,NPAGE)
C WMU
C
C
C AAR
C AAR			*** AAR CHANGE ***
C AAR	   USE THE LIST OPTION TO PRINT.
C AAR
C AAR ----
C AAR    !
300	CLOSE(UNIT=IUPGR,DISPOSE='LIST')
C AAR    !
C AAR ----
C AAR
C
400   RETURN
      END
      SUBROUTINE HEADR(ID,NS,NUMBRV,JND,IOUT,IUPGR)
      DIMENSION ID(1),IOUT(132)
      DO 1 J=NS+1,NUMBRV,8
      DO 7 L=1,133
7     IOUT(L)=' '
      JEND=J+7
      IF(JEND.GT.NUMBRV) JEND=NUMBRV
      DO 5 L=J,JEND
      K=L*JND
      MODE=ID(K)+1
      M=12+(L-J)*15
      GO TO (2,3,4),MODE
      PAUSE 'PROBLEM'
2     M=M+2
      GO TO 8
3     M=M+5
      GO TO 8
4     M=M+8
      IF(ID(K-1).EQ.'SOCSC') M=M-5
8     DECODE(5,6,ID(K-1))(IOUT(I),I=M,M+4)
6     FORMAT(5A1)
5     CONTINUE
      IF(J.EQ.(NS+1)) IOUT(1)='0'
      IF(JEND.NE.NUMBRV) GO TO 10
      IOUT(5)='O'
      IOUT(6)='B'
      IOUT(7)='S'
      IOUT(8)='.'
10    WRITE(IUPGR,9) IOUT
9     FORMAT(133A1)
1     CONTINUE
      DASH='-----'
      L=8
      IF((NUMBRV-NS).LT.8) L=NUMBRV-NS
      L=L*3
      WRITE(IUPGR,11)(DASH,I=1,L)
11    FORMAT(1X,7('-'),2X,24A5)
      RETURN
      END