*
* $Id$
*
* $Log$
* Revision 1.1  1996/02/26 17:16:23  mclareni
* Initial revision
*
*
#include "comis/pilot.h"
*CMZ :  1.18/14 15/11/94  14.07.47  by  Vladimir Berezhnoi
*-- Author : V.Berezhnoi
      SUBROUTINE CSFMTP(FORM)
      CHARACTER *(*)FORM, FDS*32, CH*1, CSNOTB*1, CSGETN*1
      CHARACTER ERROR*40, DOTS*5
      PARAMETER (LIMIT=502, LCOD=LIMIT+ 10)
      INTEGER   COD(LCOD)
      COMMON/ CSFICD /ICOD,COD
      LOGICAL   SLASH
      SAVE FDS
      DATA FDS/'0123456789LIZOFEDGAHXTPBS/()'',:$'/
*     K=        12345678911111111112222222222 333
*                        01234567890123456789 012
      DATA DOTS/' ... '/
      N=LEN(FORM)
*??      IF(N.GT.256)GO TO 70
      I=1
      ICOD=1
      CH=CSNOTB(FORM,I,N)
      IF(CH.EQ.' ')GO TO 71
      IF(CH.NE.'(')GO TO 71
      LEVEL=1
      SLASH=.FALSE.
      NREP=0
 111  CH=CSNOTB(FORM,I,N)
      IF(CH.EQ.' ')GO TO 71
      IF(CH.NE.'/')GO TO 112
      SLASH=.TRUE.
      COD(ICOD)=5
      ICOD=ICOD+1
      IF(ICOD.GT.LIMIT)GO TO 70
      GO TO 111
 112  K=INDEX( FDS, CH )
      IF(K.EQ.0)GO TO 71
      IF(ICOD.GT.LIMIT)GO TO 70
      GO TO (1 ,1 ,1 ,1 ,1 ,1 ,1 ,1 ,1 ,1 ,
*     K=     1  2  3  4  5  6  7  8  9  10
     +       11,11,11,11,15,15,15,15,19,71,
*     K=     11 12 13 14 15 16 17 18 19 20
     +       71,22,71,24,25,26,27,28,29,30,31,31
*     K=     21 22 23 24 25 26 27 28 29 30 31 32
     +       ),K
 1    CONTINUE
*     DIGIT:  nX or nH nP or repc
      NUM=K-1
      CH=CSGETN(FORM,I,N,NUM)
      IF(CH.EQ.' ')GO TO 71
      IF    (CH.EQ.'H')THEN
*       nHc1c2...cn
        COD(ICOD)=INDEX(FDS,CH)
        COD(ICOD+1)=NUM
        COD(ICOD+2)=I
        ICOD=ICOD+3
        I=I+NUM
      ELSEIF(CH.EQ.'X')THEN
*       nX
        COD(ICOD)=INDEX(FDS,CH)
        COD(ICOD+1)=NUM
        ICOD=ICOD+2
      ELSEIF(CH.EQ.'P')THEN
*       nP
        GO TO 72
      ELSE
        NREP=NUM
*        CH=CSNOTB(FORM,I,N)
*        IF(CH.EQ.' ')GO TO 71
        GO TO 112
      ENDIF
      CH=CSNOTB(FORM,I,N)
      GO TO 61
 11   CONTINUE
*     Lw or Iw or Zw or Ow
      COD(ICOD)=K
      KI=K
      IF(NREP.EQ.0)NREP=1
      COD(ICOD+1)=NREP
      COD(ICOD+3)=I-1
      CH=CSNOTB(FORM,I,N)
      IF(CH.EQ.' ')GO TO 71
      K=INDEX(FDS,CH)
      IF(K.EQ.0 .OR. K.GE.11) GO TO 71
      NUM=K-1
      CH=CSGETN(FORM,I,N,NUM)
      COD(ICOD+2)=NUM
      IF(KI.EQ.12)THEN
*---  may be Iw.m
        IF(CH.EQ.'.')THEN
          CH=CSNOTB(FORM,I,N)
          IF(CH.EQ.' ')GO TO 71
          K=INDEX(FDS,CH)
          IF(K.EQ.0 .OR. K.GE.11) GO TO 71
          NUM=K-1
          CH=CSGETN(FORM,I,N,NUM)
        ENDIF
      ENDIF
      COD(ICOD+4)=I-2
      ICOD=ICOD+5
      GO TO 61
 15   CONTINUE
*     Fw.d or Ew.d or Dw.d or Gw.d
      COD(ICOD)=K
      IF(NREP.EQ.0)NREP=1
      COD(ICOD+1)=NREP
      COD(ICOD+3)=I-1
      CH=CSNOTB(FORM,I,N)
      IF(CH.EQ.' ')GO TO 71
      K=INDEX(FDS,CH)
      IF(K.EQ.0 .OR. K.GE.11) GO TO 71
      NUM=K-1
      CH=CSGETN(FORM,I,N,NUM)
      COD(ICOD+2)=NUM
      IF(CH.NE.'.')GO TO 71
      CH=CSNOTB(FORM,I,N)
      IF(CH.EQ.' ')GO TO 71
      K=INDEX(FDS,CH)
      IF(K.EQ.0 .OR. K.GE.11) GO TO 71
      NUM=K-1
      CH=CSGETN(FORM,I,N,NUM)
      COD(ICOD+4)=I-2
      ICOD=ICOD+5
      GO TO 61
 19   CONTINUE
*     A or Aw
      COD(ICOD)=K
      IF(NREP.EQ.0)NREP=1
      COD(ICOD+1)=NREP
      COD(ICOD+3)=I-1
      CH=CSNOTB(FORM,I,N)
      IF(CH.EQ.' ')GO TO 71
      K=INDEX(FDS,CH)
      IF(K.EQ.0 .OR. K.GE.11)THEN
        COD(ICOD+2)=0
        COD(ICOD+4)=I-2
      ELSE
        NUM=K-1
        CH=CSGETN(FORM,I,N,NUM)
        COD(ICOD+2)=NUM
        COD(ICOD+4)=I-2
      ENDIF
      ICOD=ICOD+5
      GO TO 61
 22   CONTINUE
*     Tw or TLw or TRw
      COD(ICOD)=K
      IF(NREP.NE.0)GO TO 71
      CH=FORM(I:I)
      IF(CH.EQ.'L')THEN
        I=I+1
        COD(ICOD)=K+1
      ELSEIF(CH.EQ.'R')THEN
        I=I+1
        COD(ICOD)=K+2
      ENDIF
      CH=CSNOTB(FORM,I,N)
      IF(CH.EQ.' ')GO TO 71
      K=INDEX(FDS,CH)
      IF(K.EQ.0 .OR. K.GE.11) GO TO 71
      NUM=K-1
      CH=CSGETN(FORM,I,N,NUM)
      COD(ICOD+1)=NUM
      ICOD=ICOD+2
      GO TO 61
 24   CONTINUE
*     BN or BZ
        GO TO 72
 25   CONTINUE
*     S or SS or SP
        GO TO 72
 26   CONTINUE
*     /
        GO TO 71
 27   CONTINUE
*     (
      IF(LEVEL.EQ.1)THEN
        COD(ICOD)=1
        ICOD=ICOD+1
      ENDIF
      LEVEL=LEVEL+1
      IF(LEVEL.GT.9)GO TO 70
      IF(NREP.EQ.0)NREP=1
      COD(ICOD)=2
      COD(ICOD+1)=NREP
      ICOD=ICOD+2
      NREP=0
      GO TO 111
 28   CONTINUE
*     )
      GO TO 71
 29   CONTINUE
*     '....'
      COD(ICOD)=K
      IF(NREP.NE.0)GO TO 71
      COD(ICOD+1)=I
      I=I-1
 290  I=I+1
      IF(I.GT.N)GO TO 71
      CH=FORM(I:I)
      IF(CH.NE.'''')GO TO 290
      I=I+1
      IF(I.GT.N)GO TO 71
      CH=FORM(I:I)
      IF(CH.EQ.'''')GO TO 290
      COD(ICOD+2)=I-2
      ICOD=ICOD+3
      CH=CSNOTB(FORM,I,N)
      GO TO 61
 30   CONTINUE
*     ,
      IF(.NOT.SLASH)GO TO 71
      CH=CSNOTB(FORM,I,N)
      IF(CH.EQ.' ')GO TO 71
      IF(CH.NE.'/')GO TO 112
      GO TO 62
 31   CONTINUE
*     : or $
      COD(ICOD)=K
      ICOD=ICOD+1
      CH=CSNOTB(FORM,I,N)
      GO TO 61
* delimiter
 61   IF(CH.EQ.' ')GO TO 71
      NREP=0
      IF(CH.EQ.',')THEN
*         skip
        CH=CSNOTB(FORM,I,N)
        IF(CH.EQ.' ')GO TO 71
        IF(CH.NE.'/')GO TO 112
      END IF
      SLASH=.FALSE.
 62   IF(CH.EQ.'/')THEN
        SLASH=.TRUE.
        COD(ICOD)=5
        ICOD=ICOD+1
        IF(ICOD.GT.LIMIT)GO TO 70
        CH=CSNOTB(FORM,I,N)
        IF(CH.EQ.' ')GO TO 71
        GO TO 62
      END IF
      IF(SLASH .AND. CH.NE.')' )GO TO 112
 63   IF( CH .EQ. ')' )THEN
        IF(LEVEL.EQ.1)GO TO 99
        LEVEL=LEVEL-1
        COD(ICOD)=3
        ICOD=ICOD+1
        IF(ICOD.GT.LIMIT)GO TO 70
        CH=CSNOTB(FORM,I,N)
        GO TO 61
      ELSE
        GO TO 71
      ENDIF
  70  CONTINUE
      ERROR=' too long or complex format'
      GO TO 77
  71  CONTINUE
      ERROR=' error in format'
      GO TO 77
  72  CONTINUE
      ERROR=' sorry, not implemented yet'
      GO TO 77
  73  CONTINUE
      ERROR=' extra symbol after format statement'
      GO TO 77
  77  CONTINUE
      PRINT *,ERROR
      IF(I.EQ.1)THEN
        PRINT *, DOTS ,FORM
      ELSEIF(I.LT.N)THEN
        PRINT 7771,FORM(1:I-1),DOTS, FORM(I:N)
 7771 FORMAT(1X,A,A,A)
      ELSE
        PRINT *, FORM(1:N)
      ENDIF
      ICOD=1
      RETURN
  99  CONTINUE
*     end of format
      COD(ICOD)=4
      ICOD=ICOD+1
      II=I
      CH=CSNOTB(FORM,II,N)
      IF(CH.NE.' ')GO TO 73
      END
