*DECK LCMULT
      SUBROUTINE LCMULT(IPLIST,FLOTT)
*
*-----------------------------------------------------------------------
*
* MULTIPLY THE FLOATING POINT INFORMATION CONTAINED IN THE ACTIVE
* DIRECTORY OF A TABLE OR XSM FILE BY A REAL NUMBER.
*
* INPUT PARAMETERS:
*  IPLIST : ADDRESS OF THE TABLE OR HANDLE TO THE XSM FILE.
*  FLOTT  : REAL NUMBER.
*
* OUTPUT PARAMETER:
*  IPLIST : ADDRESS OF THE TABLE OR HANDLE TO THE XSM FILE.
*
*------------------------------------- AUTHOR: A. HEBERT ; 02/11/93 ----
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      TYPE(C_PTR) IPLIST
      REAL FLOTT
*----
*  LOCAL VARIABLES
*----
      PARAMETER (MAXLEV=50)
      TYPE(C_PTR) KDATA(MAXLEV)
      CHARACTER NAMT*12,HSMG*131,MYNAME*12,NAMLCM*12,PATH(MAXLEV)*12,
     1 FIRST(MAXLEV)*12
      LOGICAL EMPTY,LCM
      INTEGER IVEC(MAXLEV),KJLON(MAXLEV),IGO(MAXLEV)
      TYPE(C_PTR) :: PT_DATA
      REAL, POINTER :: RRR(:)
      DOUBLE PRECISION, POINTER :: DDD(:)
      COMPLEX, POINTER :: CCC(:)
*
      CALL LCMVAL(IPLIST,' ')
      ILEV=1
      KDATA(1)=IPLIST
      KJLON(1)=-1
      IVEC(1)=1
      IGO(1)=5
*
* ASSOCIATIVE TABLE.
   10 CALL LCMINF(IPLIST,MYNAME,NAMLCM,EMPTY,ILONG,LCM)
      IF(EMPTY) GO TO (100,100,240,240,250),IGO(ILEV)
      NAMT=' '
      CALL LCMNXT(IPLIST,NAMT)
*
      FIRST(ILEV)=NAMT
   15 CALL LCMLEN(IPLIST,NAMT,ILON1,ITY1)
      IF(ITY1.EQ.0) THEN
*        ASSOCIATIVE TABLE DATA.
         ILEV=ILEV+1
         IF(ILEV.GT.MAXLEV) THEN
            WRITE(HSMG,'(2A,A12,A)') 'LCMULT: TOO MANY DIRECTORY ',
     1      'LEVELS ON ''',MYNAME,'''(1).'
            CALL XABORT(HSMG)
         ENDIF
         KJLON(ILEV)=-1
         KDATA(ILEV)=LCMGID(IPLIST,NAMT)
         PATH(ILEV)=NAMT
         IPLIST=KDATA(ILEV)
         IVEC(ILEV)=1
         IGO(ILEV)=1
         GO TO 10
      ELSE IF(ITY1.EQ.10) THEN
*        LIST DATA.
         ILEV=ILEV+1
         IF(ILEV.GT.MAXLEV) THEN
            WRITE(HSMG,'(2A,A12,A)') 'LCMULT: TOO MANY DIRECTORY ',
     1      'LEVELS ON ''',MYNAME,'''(2).'
            CALL XABORT(HSMG)
         ENDIF
         KJLON(ILEV)=ILON1
         KDATA(ILEV)=LCMGID(IPLIST,NAMT)
         PATH(ILEV)=NAMT
         IPLIST=KDATA(ILEV)
         IVEC(ILEV)=0
         IGO(ILEV)=2
         GO TO 190
      ELSE IF(ITY1.EQ.2) THEN
*        SINGLE PRECISION DATA.
         CALL LCMGPD(IPLIST,NAMT,PT_DATA)
         CALL C_F_POINTER(PT_DATA, RRR, (/ ILON1 /))
         DO 70 I=1,ILON1
   70    RRR(I)=FLOTT*RRR(I)
         CALL LCMPPD(IPLIST,NAMT,ILON1,ITY1,PT_DATA)
      ELSE IF(ITY1.EQ.4) THEN
*        DOUBLE PRECISION DATA.
         CALL LCMGPD(IPLIST,NAMT,PT_DATA)
         CALL C_F_POINTER(PT_DATA, DDD, (/ ILON1 /))
         DO 80 I=1,ILON1
   80    DDD(I)=FLOTT*DDD(I)
         CALL LCMPPD(IPLIST,NAMT,ILON1,ITY1,PT_DATA)
      ELSE IF(ITY1.EQ.6) THEN
*        COMPLEX DATA.
         CALL LCMGPD(IPLIST,NAMT,PT_DATA)
         CALL C_F_POINTER(PT_DATA, CCC, (/ ILON1 /))
         DO 90 I=1,ILON1
   90    CCC(I)=FLOTT*CCC(I)
         CALL LCMPPD(IPLIST,NAMT,ILON1,ITY1,PT_DATA)
      ENDIF
      CALL LCMNXT(IPLIST,NAMT)
      IF(NAMT.NE.FIRST(ILEV)) GO TO 15
      GO TO (100,100,240,240,250),IGO(ILEV)
*
  100 NAMT=PATH(ILEV)
      ILEV=ILEV-1
      IPLIST=KDATA(ILEV)
      CALL LCMNXT(IPLIST,NAMT)
      IF(NAMT.NE.FIRST(ILEV)) GO TO 15
      GO TO (100,100,240,240,250),IGO(ILEV)
*
* LIST.
  190 IVEC(ILEV)=IVEC(ILEV)+1
      IF(IVEC(ILEV).GT.KJLON(ILEV)) THEN
         GO TO (100,100,240,240,250),IGO(ILEV)
      ENDIF
      CALL LCMLEL(KDATA(ILEV),IVEC(ILEV),ILON1,ITY1)
      IF((ILON1.NE.0).AND.(ITY1.EQ.0)) THEN
*        ASSOCIATIVE TABLE DATA.
         ILEV=ILEV+1
         IF(ILEV.GT.MAXLEV) THEN
            WRITE(HSMG,'(2A,A12,A)') 'LCMULT: TOO MANY DIRECTORY ',
     1      'LEVELS ON ''',MYNAME,'''(3).'
            CALL XABORT(HSMG)
         ENDIF
         KJLON(ILEV)=-1
         KDATA(ILEV)=LCMGIL(IPLIST,IVEC(ILEV-1))
         IPLIST=KDATA(ILEV)
         IVEC(ILEV)=1
         IGO(ILEV)=3
         GO TO 10
      ELSE IF((ILON1.NE.0).AND.(ITY1.EQ.10)) THEN
*        LIST DATA.
         ILEV=ILEV+1
         IF(ILEV.GT.MAXLEV) THEN
            WRITE(HSMG,'(2A,A12,A)') 'LCMULT: TOO MANY DIRECTORY ',
     1      'LEVELS ON ''',MYNAME,'''(4).'
            CALL XABORT(HSMG)
         ENDIF
         KJLON(ILEV)=ILON1
         KDATA(ILEV)=LCMGIL(IPLIST,IVEC(ILEV-1))
         IPLIST=KDATA(ILEV)
         IVEC(ILEV)=0
         IGO(ILEV)=4
         GO TO 190
      ELSE IF((ILON1.NE.0).AND.(ITY1.LE.6)) THEN
         IF((ITY1.EQ.2).OR.(ITY1.EQ.6)) THEN
*           SINGLE PRECISION DATA.
            CALL LCMGPL(IPLIST,IVEC(ILEV),PT_DATA)
            CALL C_F_POINTER(PT_DATA, RRR, (/ ILON1 /))
            DO 210 I=1,ILON1
  210       RRR(I)=FLOTT*RRR(I)
            CALL LCMPPL(IPLIST,IVEC(ILEV),ILON1,ITY1,PT_DATA)
         ELSE IF(ITY1.EQ.4) THEN
*           DOUBLE PRECISION DATA.
            CALL LCMGPL(IPLIST,IVEC(ILEV),PT_DATA)
            CALL C_F_POINTER(PT_DATA, DDD, (/ ILON1 /))
            DO 220 I=1,ILON1
  220       DDD(I)=FLOTT*DDD(I)
            CALL LCMPPL(IPLIST,IVEC(ILEV),ILON1,ITY1,PT_DATA)
         ELSE IF(ITY1.EQ.6) THEN
*           COMPLEX DATA.
            CALL LCMGPL(IPLIST,IVEC(ILEV),PT_DATA)
            CALL C_F_POINTER(PT_DATA, CCC, (/ ILON1 /))
            DO 230 I=1,ILON1
  230       CCC(I)=FLOTT*CCC(I)
            CALL LCMPPL(IPLIST,IVEC(ILEV),ILON1,ITY1,PT_DATA)
         ENDIF
      ENDIF
      GO TO 190
*
  240 ILEV=ILEV-1
      IPLIST=KDATA(ILEV)
      GO TO 190
*
  250 RETURN
      END
