      SUBROUTINE PICTUR(VARI,TIT,JA,JE,KA,KE, LA, LE,LEVEL,MX,MY,MZ,
     .     DI1, DI2, DI3, DI12)
      SAVE
C
C     Must be compiled under CRAY,VAXVMS,or UNIX
C     PRINT THE VARIABLE
C     VARI            WITH THE EBDIC NAME '   ',
C     TIT             -6 HOOLERITH
C     JA  UPTO  JE                 ---- FOR THE 1RST INDEX RUNNING FROM
C     KA  UPTO  KE                 ---- FOR THE 2ND  INDEX RUNNING FROM
C     LA  UPTO  LE                 ---- FOR THE 3RD  INDEX RUNNING FROM
C     IF THE OPTION
C     LEVEL = 0       PRINT BY ECNVRT
C           = N       N < 41  SCALE THE DATA BY (LEVEL-1)/(MAX(VARI)-MIN(VARI)
C                     AND USE THE RESULT TO SELECT A CHARACTER FOR REPRESEN
C                     THE DATA.
C     LEVEL < 0       AS ABOVE, BUT USE ALOG10 FOR SCALING  THE DATA
C                     IF SOME DATA <1.E-70 USE SIGN + QRT(SQRT OF THE DATA
C                  IF ALL THE DATA ARE THE SAME PRINT ONLY THIS VALUE
C     THE PINTOUT IMAGE IS ORGANIZED IN  COLUMNS --1--, ROWS --2--- AND
C     BLOCKS --3  -- 
C  MX SET TO 1 OR 2 OR 3     1RST INDEX SHALL APPEAR IN COL. ROW OR BLOCK
C  MY SET TO 1 OR 2 OR 3     2ND  INDEX SHALL APPEAR IN COL. ROW OR BLOCK
C  MZ SET TO 1 OR 2 OR 3     3RD  INDEX SHALL APPEAR IN COL. ROW OR BLOCK
C     IMPROPER SETTING OF MX, MY, MX RESULTS IN THE SEQUENCE, 1, 2, 3.
c  let the base array be a(i,j,k):
c      (mx,my,mz) = (1,2,3) is i across, j up and down, k in blocks
c      (mx,my,mz) = (2,3,1) is i in blocks, j across, k up and down
c      the ranges in index are independent of how the data are displayed
C  DI1, DI2, DI3   ARE THE DIMENSION OF THE VARIABLE VARI
C  DI12            IS THE SPACING FOR THE 3RD INDEX AND WILL BE NORMALLY
C     VAXVMS VERSION !!!!!!DATA RANGE .29E-38  TO 1.7E38. ALSO DATA STORED
C         DIFFERENTLY! UNDEF MASK CHANGED FROM ZFF0000 TO 7!!!!!!
C                  BE = DI1*DI2
      character*(*) tit
      INTEGER      DOL(2,3), XAD(2,3), XML(2,3)
     .         ,   DI1, DI2, DI3, DI12
      REAL         VARI(*), SVARI(132), AVARI(132)
      CHARACTER    LINE*144, IMAGE(21)*6, ALFA*41, NUM*6, IFMT*4
     .     ,       LIN4(36)*4, JFOR4(8)*4, JFORM*32, ALF1(41)*1
      EQUIVALENCE (LINE (1:1), LIN4(1)(1:1))
     .     ,      (ALFA (1:1), ALF1(1)(1:1))
     .     ,      (JFORM(1:1),JFOR4(1)(1:1)), (UNTEST, INTEST)
C
      DATA   JFOR4   /'(''0''',',3X,','MUL','(','NUM','I3,','NX','X))'/
#ifdef CRAY
      DATA   NUM     /'    * '/, IFMT/'(I4)'/, IUNDEF/3770B/
#else /*CRAY*/
#ifdef VAXVMS
      DATA   NUM     /'    * '/, IFMT/'(I4)'/, IUNDEF/'3770'O/           !VAXVMS
#else /*VAXVMS*/
      DATA   NUM     /'    * '/, IFMT/'(I4)'/, IUNDEF/o'3770'/
#endif /*VAXVMS*/
#endif /*CRAY*/
      DATA   LIN4    /'(', '132H', 33*' ', ')'/
      DATA   ALF1    /'0','1','2','3','4','5','6','7','8','9',
     1                 'A','B','C','D','E','F','G','H','I','J',
     2                 'K','L','M','N','O','P','Q','R','S','T',
     3                 'U','V','W','X','Y','Z','+','-','*','/', '$'/
      INTEGER MULT(11)
        data mult /1, 2, 3, 4, 5, 8, 10, 12, 20, 40, 41/
        character*6 titl
      LOGICAL SINGLE
      DATA    XML  / 1, 0, 0, 1, 0, 1/
#ifdef DEBUG_MODE_ON
      write(*,*) "DEBUG:  in picture.F::PICTUR(...)"
#endif
      SINGLE = .FALSE.
C
        titl ='      '
        lmax = min0(6,len(tit))
        titl(1:lmax) = tit(1:lmax)
C

      IX = MX
      IY = MY
      IZ = MZ
      NT = MX+MY+MZ
      IF(NT .EQ.6) GOTO 5
      WRITE(9, 99) MX, MY, MZ
 99   FORMAT('0    ****       ARRAY INDICES AT FAULT', 3I6, 5X, '*****')
      IX = 1
      IY = 2
      IZ = 3
 5    NSI = DI1
      XML(2,2) = NSI
      XML(2,3) = DI12
      DOL(1,1) = MAX0(1,        MIN0(JA, NSI))
      DOL(2,1) = MAX0(DOL(1,1), MIN0(JE, NSI))
      DOL(1,2) = MAX0(1,        MIN0(KA, DI2))
      DOL(2,2) = MAX0(DOL(1,2), MIN0(KE, DI2))
      DOL(1,3) = MAX0(1,        MIN0(LA, DI3))
      DOL(2,3) = MAX0(DOL(1,3), MIN0(LE, DI3))
      J1 = DOL(1,1)
      JX = DOL(2,1)
      K1 = DOL(1,2)
      KY = DOL(2,2)
      L1 = DOL(1,3)
      LZ = DOL(2,3)
      XMAX = -1.E38
      XMIN =  1.E38
      DO 6 L = L1,LZ
      DO 6 K = K1,KY
      NAD = (K-1)*NSI+(L-1)*DI12
      DO 7 J = J1,JX
      XMAX = AMAX1(XMAX, VARI(J+NAD))
      XMIN = AMIN1(XMIN, VARI(J+NAD))
 7    CONTINUE
 6    CONTINUE
      IF(XMAX .GT. XMIN) GOTO 8
      WRITE(9, 105) TITL, XMIN, J1, JX, K1, KY, L1, LZ
 105  FORMAT('   *****  FOR  ', A6, '   ALL DATA=', 1PE12.4,
     .     '  FOR INDICES IN RANGE', 3(I6,I4), '  *****')
      RETURN
C
 8    IF(LEVEL .EQ.0) GOTO 9
      SINGLE = .TRUE.
C     FOR CHARACTER DISPLAY CHECK FOR UNDEFINED-UNNORMALIZED (8-15) NUMB
      DO 40 L = L1,LZ
      DO 40 K = K1,KY
      NAD = (K-1)*NSI+(L-1)*DI12
      DO 41 J = J1,JX
      IF(    VARI(J+NAD) .EQ.0.) GOTO 41
      UNTEST = VARI(J+NAD)
      IF(IAND(INTEST, IUNDEF) .NE. 0) GOTO 41
      WRITE(9, 120)
 120  FORMAT(' = = =  UNDEFINED OR UNNORMALIZED DATA  = = = ')
      IWANT = IAND(INTEST,IUNDEF)
      WRITE(9, 200)UNTEST, INTEST, INTEST, IWANT, IUNDEF
 200  FORMAT(5X, 1P1E12.4, I12, 3Z20)
      GOTO 9
 41   CONTINUE
 40   CONTINUE
C
 9    J1 = DOL(1,IX)
      J2 = DOL(2,IX)
      K1 = DOL(1,IY)
      KY = DOL(2,IY)
      L1 = DOL(1,IZ)
      LZ = DOL(2,IZ)
      XAD(1,1) = XML(1,IX)
      XAD(2,1) = XML(2,IX)
      XAD(1,2) = XML(1,IY)
      XAD(2,2) = XML(2,IY)
      XAD(1,3) = XML(1,IZ)
      XAD(2,3) = XML(2,IZ)
C
      WRITE(9, 100) TITL,   IX, IY, IZ
 100  FORMAT('  ***   ', A6, 6X, I4, '-COLUMN', I4, '-ROW', I4,
     .   '-BLOCK', '   ****   ')
      IF(SINGLE) GOTO 10
C
      DO 2 L = L1,LZ
      WRITE(9, 101) TITL,  IZ, L
      J1 = DOL(1,IX)
      IL = L*XAD(1,3) + (L-1)*XAD(2,3)
 1    JX = MIN0(J2, J1+20)
      MM = JX-J1+1
      WRITE(9, 102) IX, IY, (J,J=J1,JX)
 101  FORMAT(' '/6X, A6, '  ARRAY INDEX', I4, '  BLOCK', 20I4)
 102  FORMAT('0#',I1,' / #', I1, I4, 21I6)
 103  FORMAT(' ', I3, '* ', 21A6)
      DO  3 KK = K1,KY
      K = K1+KY-KK
      IK = K*XAD(1,2)+(K-1)*XAD(2,2)+IL
      LS = 0
      DO 4 J = J1,JX
      LS = LS+1
 4    SVARI(LS) = VARI(J*XAD(1,1)+(J-1)*XAD(2,1)+IK)
      CALL ECNVRT(SVARI, IMAGE, MM)
 3    WRITE(9, 103) K, (IMAGE(M), M=1,MM)
      IF(JX .EQ.J2) GOTO 2
      J1 = J1+21
      GOTO 1
 2    CONTINUE
      RETURN
C    -----------
C
 10   LEV = MIN0(40, IABS(LEVEL))
      LEV1 = 1
      LEV = MAX0(2,LEV)
      NIV = LEV
      IF(LEVEL .GT.0) GOTO 53
      IF(XMIN .GT. 1.E-35 .AND. XMAX .LT. 1.E35) GOTO 50
      XMA  = SQRT(SQRT(ABS(XMAX)))
      XMI  = SQRT(SQRT(ABS(XMIN)))
      XMAX = SIGN(XMA, XMAX)
      XMIN = SIGN(XMI, XMIN)
      LEV1 = 2
      GOTO 53
 50   LOGA = IFIX(ALOG10(XMAX*.99999)) + 1
      LOGB = ALOG10(XMIN*1.00001 )
      IF(XMAX .LT.1.) LOGA = LOGA-1
      IF(XMIN .LT. 1.) LOGB = LOGB-1
      LEV2 = LOGA-LOGB
      IF(LEV2 .GT. 1) GOTO 52
      GOTO 53
 52   LEV1 = -1
      XMAX = LOGA
      XMIN = LOGB
      GOTO 55
 53   EXPO = AMAX1(ABS(XMAX), ABS(XMIN))
      IF(EXPO .LT. 1.E-32 .OR. EXPO .GT. 1.E35) GOTO 12
      LOGA = ALOG10(EXPO)
      IF(EXPO .LT. 1.) LOGA = LOGA-1
      EXPO = 10.**LOGA
      XPO = EXPO*1.E-3
 54   NTOP = IFIX((XMAX*.99999)/EXPO) + 1
      NBOT = int((XMIN*0.99999)/EXPO)
      IF(NTOP-NBOT .GT.1) GOTO 56
      IF(EXPO .LT. XPO) GOTO 12
      EXPO = EXPO*.1
      GOTO 54
 56   IF(XMAX .EQ.0.) NTOP=0
      IF(XMIN .GT.0.) GOTO 51
      NBOT = NBOT-1
      IF(XMIN .EQ.0.) NBOT=0
 51   XMAX = NTOP*EXPO
      XMIN = NBOT*EXPO
      LEV2 = MAX0(1,NTOP-NBOT)
C
 55   LMAX = MIN0(40, NIV+(LEV2+1)/2)
      IF(LEV2 .LT. LMAX) GOTO 57
      LEV2 = (LEV2+1)/2
      GOTO 55
 57   MULT(9)  = MAX0(MULT(8),(LMAX+1)/2)
      MULT(10) = LMAX
      MULT(11) = LMAX+1
      DO 58 L = 2,11
      IF(LEV2*MULT(L) .GT. LMAX) GOTO 59
 58   CONTINUE
      L = 11
 59   LEV = LEV2*MULT(L-1)+1
 12   XNORM = (XMAX-XMIN)/float(LEV-1)
      DO 14 L = 1,LEV
 14   SVARI(L) = (L-1)*XNORM+XMIN
      IF(LEV1 .EQ. 1) GOTO 17
      IF(LEV1 .EQ. 2) GOTO 18
      DO 15 L = 1,LEV
 15   SVARI(L) = 10.**SVARI(L)
      GOTO 17
 18   DO 19 L = 1,LEV
      AVARI(L) = SVARI(L)**4
 19    SVARI(L) = SIGN(AVARI(L), SVARI(L))
 17   WRITE(9, 110) (ALFA(L:L), SVARI(L), L=1,LEV)
 110  FORMAT(8(2X,A1, ' =', 1PE11.3))
      XNORM = 1./XNORM
C -----------
 21   JX = MIN0(J2, J1+121)
      JD = JX-J1+7
      MUL = 128/JD
      DO 20 L = L1,LZ,MUL
      DO 22 M = 9,140
 22   LINE(M:M) = ' '
      LM = MIN0(LZ, L+MUL-1)
      WRITE(9, 101) TITL, IZ, (I, I=L,LM)
      N1 = (JX-J1)/3+1
      N2 = JX-J1+7-N1*3
      WRITE(JFORM(9:12),IFMT) LM
      WRITE(JFOR4(5),   IFMT) N1
      WRITE(JFOR4(7),   IFMT) N2
      WRITE(9, JFORM) ((J, J=J1,JX,3), M=L, LM)
      DO 23 KK = K1,KY
      K = K1+KY-KK
      WRITE(NUM, IFMT)K
      IK = K*XAD(1,2)+(K-1)*XAD(2,2)
      N = 0
      NA = 9
      DO 25 M = L,LM
      IL = M*XAD(1,3) + (M-1)*XAD(2,3) +IK
      NB = NA+5
      LINE(NA:NB) = NUM(1:6)
      NB = NB-N
      NS = N+1
      DO 28 J = J1, JX
      N = N+1
 28   SVARI(N) = VARI(J*XAD(1,1)+(J-1)*XAD(2,1)+IL)
      IF(LEV1 .EQ. 1) GOTO 30
      IF(LEV1 .EQ. 2) GOTO 36
      DO 29 I = NS,N
 29   SVARI(I) = ALOG10(AMAX1(1.E-34, SVARI(I)))
      GOTO 30
 36   DO 34 I = NS,N
      AVARI(I) = SQRT(SQRT(ABS(SVARI(I))))
 34   SVARI(I) = SIGN(AVARI(I), SVARI(I))
 30   DO 32 I = NS,N
      NC = MIN0(40, MAX0(1, IFIX((SVARI(I)-XMIN)*XNORM+1)))
 32   LINE(NB+I:NB+I) = ALFA(NC:NC)
       NA = NA+7 +N-NS
 25   CONTINUE
 23   WRITE(9, LINE)
 20   CONTINUE
      IF(JX .EQ. J2) RETURN
      J1 = J1+122
      GOTO 21
      return
      END
         subroutine print2d(var,tit,mi,mj,li,lj)
        dimension var(li,lj)
        character*(*) tit
C
        ll = min(len(tit),6)
        call pictur(var,tit(1:ll),1,mi,1,mj,1,1,0,1,2,3,li,lj,1,li*lj)
C
        return
        end
        SUBROUTINE PRINT3(NAME,VAR,NI,NJ,NK)
        CHARACTER*(*) NAME
        DIMENSION VAR(NI,NJ,NK)
#ifdef DEBUG_MODE_ON
      write(*,*) "DEBUG:  in picture.F::PRINT3(...)"
#endif
C
        ll = min(6,len(name))
        call pictur(var,name(1:ll),1,ni,1,nj,1,nk,0,1,2,3,
     $          ni,nj,nk,ni*nj)
C
        RETURN
        END
      SUBROUTINE ECNVRT(VARI, IMAGE, LN)
      SAVE
C
CD* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
CD
CD    ECNVRT(DIN, DOUT, N)
CD    ORIGINATOR:   E. DENT            CODE 7750,NRL                1970
C g.hain modernized july 1983
C modified jgl for error branch feb 2002
C
C
      PARAMETER (LIN=22, LIN9=LIN*9)
      CHARACTER STOR9(LIN)*9, IMAGE(LIN)*6, ALPHA(144)*2, STORE(1)*198
      REAL      VARI (LIN)
      INTEGER   LIST (LIN)
      EQUIVALENCE    (STORE(1)(1:1), STOR9(1)(1:1))
C
C     NUMERICAL-ALPHABETICAL REPRESENTATION FOR THE ONE FIGURE EXPONET.
      DATA ALPHA
     .       /  '=*','=Z','=Y','=X','=W','=V','=U','=T','=S','=R','=Q',
     1     '=P','=O','=N','=M','=L','=K','=J','=I','=H','=G','=F','=E',
     2     '=D','=C','=B','=A','=9','=8','=7','=6','=5','=4','=3','=2',
     3     '=1','-Z','-Y','-X','-W','-V','-U','-T','-S','-R','-Q','-P',
     4     '-O','-N','-M','-L','-K','-J','-I','-H','-G','-F','-E','-D',
     5     '-C','-B','-A','-9','-8','-7','-6','-5','-4','-3','-2','-1',
     6     '+0','+1','+2','+3','+4','+5','+6','+7','+8','+9','+A','+B',
     7     '+C','+D','+E','+F','+G','+H','+I','+J','+K','+L','+M','+N',
     8     '+O','+P','+Q','+R','+S','+T','+U','+V','+W','+X','+Y','+Z',
     9     '&1','&2','&3','&4','&5','&6','&7','&8','&9','&A','&B','&C',
     A     '&D','&E','&F','&G','&H','&I','&J','&K','&L','&M','&N','&O',
     B     '&P','&Q','&R','&S','&T','&U','&V','&W','&X','&Y','&Z','&*',
     C     'ER'/
C
#ifdef DEBUG_MODE_ON
      write(*,*) "DEBUG:  in picture.F::ECNVRT(...)"
#endif
      JE = MAX0(1, MIN0(LIN,LN))
 100  FORMAT(1PE9.2)
        do 777 j=1,je
      WRITE (STOR9(j), 100) VARI(J)
      READ  (STOR9(j), 101, err=788) LIST(J)
      go to 777
 788  LIST(j) = 144
      STOR9(j)(1:2) = '##'
      STOR9(j)(4:5) = '##'
 101  FORMAT(6X,I3)
 777  continue
      DO 1 J = 1,JE
      LIST(J) = MIN0(72, MAX0(-71, LIST(J)))
 1    LIST(J) = LIST(J)+72
      DO 2 J =1,JE
      IMAGE(J)(1:2) = STOR9(J)(1:2)
      IMAGE(J)(3:4) = STOR9(J)(4:5)
      IMAGE(J)(5:6) = ALPHA(LIST(J))(1:2)
 2    CONTINUE
          RETURN
      END
