*DECK COMSDB
      SUBROUTINE COMSDB(IMPX,IPCPO)
*
*-----------------------------------------------------------------------
*
*Purpose:
* show the structure of a multiompo file.
*
*Copyright:
* Copyright (C) 2008 Ecole Polytechnique de Montreal
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version
*
*Author(s): R. Chambon
*
*Parameters: input
* IMPX    print parameter.
* IPCPO   pointer to the multicompo.
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      INTEGER IMPX
      TYPE(C_PTR) IPCPO
*----
*  LOCAL VARIABLES
*----
      PARAMETER (NSTATE=40,MAXPAR=50,MAXVAL=1000)
      TYPE(C_PTR) JPCPO,KPCPO
      INTEGER ISTATE(NSTATE),NVPO(2),NVALUE(2*MAXPAR)
      CHARACTER RECNAM*12,TEXT12*12,PARFMT(MAXPAR)*8,
     1 VCHAR(MAXVAL)*12,PARKEY(MAXPAR)*12,PARCPO(MAXPAR)*12
*----
*  ALLOCATABLE ARRAYS
*----
      INTEGER, ALLOCATABLE, DIMENSION(:) :: MUPCPO,JDEBAR,JARBVA,VINTE
      REAL, ALLOCATABLE, DIMENSION(:) :: VREAL
*----
*  SCRATCH STORAGE ALLOCATION
*----
      ALLOCATE(MUPCPO(2*MAXPAR))
*
      CALL LCMGET(IPCPO,'STATE-VECTOR',ISTATE)
      NMIL=ISTATE(1)
      NCAL=ISTATE(3)
      MAXCAL=ISTATE(4)
      NPAR=ISTATE(5)
      NLOC=ISTATE(6)
      IF(NPAR+NLOC.GT.2*MAXPAR) CALL XABORT('COMSDB: MAXPAR OVERFLOW.')
      IF(NCAL.EQ.0) WRITE(6,*) 'The multi-compo DB is empty.'
*----
*  MAIN LOOP OVER THE HOMOGENEOUS MIXTURES *********************
*----
      JPCPO=LCMGID(IPCPO,'MIXTURES')
      DO 190 IBM=1,NMIL
      KPCPO=LCMDIL(JPCPO,IBM)
*----
*  MAIN LOOP OVER THE NCALR ELEMENTARY CALCULATIONS OF THE COMPO
*----
      WRITE(6,*) 'LIST OF "MUPLET" included in the COMPO'
      DO 170 ICAL=1,NCAL
*----
*  COMPUTE THE MUPLET VECTOR FROM THE COMPO
*----
      CALL LCMSIX(KPCPO,'TREE',1)
      CALL LCMGET(KPCPO,'NVP',NVPO)
      MAXNVP=NVPO(2)
      ALLOCATE(JDEBAR(MAXNVP+1),JARBVA(MAXNVP))
      CALL LCMGET(KPCPO,'NCALS',NCALS)
      CALL LCMGET(KPCPO,'DEBARB',JDEBAR)
      CALL LCMGET(KPCPO,'ARBVAL',JARBVA)
      I0=0
      DO 30 I=NVPO(1)-NCALS+1,NVPO(1)
      IF(JDEBAR(I+1).EQ.ICAL) THEN
         I0=I
         GO TO 40
      ENDIF
   30 CONTINUE
      CALL XABORT('COMSDB: MUPLET ALGORITHM FAILURE 1.')
   40 MUPCPO(NPAR+NLOC)=JARBVA(I0)
      DO 60 IPAR=NPAR+NLOC-1,1,-1
      I0=0
      DO 50 I=1,NVPO(1)-NCALS
      IF(JDEBAR(I+1).GT.I0) THEN
         I0=I
         GO TO 60
      ENDIF
   50 ENDDO
      CALL XABORT('COMSDB: MUPLET ALGORITHM FAILURE 2.')
   60 MUPCPO(IPAR)=JARBVA(I0)
      DEALLOCATE(JARBVA,JDEBAR)
      CALL LCMSIX(KPCPO,' ',2)
      WRITE(6,*)'ICAL #',ICAL,': ',(MUPCPO(JM),JM=1,NPAR+NLOC)
      IF(IMPX.LE.1) GOTO 170
*----
*  RECOVER THE GLOBAL PARAMETERS
*----
         CALL LCMSIX(IPCPO,'GLOBAL',1)
         CALL LCMGTC(IPCPO,'PARKEY',12,NPAR,PARCPO)
         CALL LCMGTC(IPCPO,'PARFMT',8,NPAR,PARFMT)
         CALL LCMGET(IPCPO,'NVALUE',NVALUE)
         DO 100 IPAR=1,NPAR
            WRITE(RECNAM,'(''pval'',I8.8)') IPAR
            IVAL=MUPCPO(IPAR)
            IF(PARFMT(IPAR).EQ.'REAL') THEN
               ALLOCATE(VREAL(NVALUE(IPAR)))
               CALL LCMGET(IPCPO,RECNAM,VREAL)
               FLOTT=VREAL(IVAL)
               DEALLOCATE(VREAL)
               write(6,*)'IPAR ',IPAR,'->',PARCPO(IPAR),FLOTT
            ELSE IF(PARFMT(IPAR).EQ.'INTEGER') THEN
               ALLOCATE(VINTE(NVALUE(IPAR)))
               CALL LCMGET(IPCPO,RECNAM,VINTE)
               NITMA=VINTE(IVAL)
               DEALLOCATE(VINTE)
               write(6,*)'IPAR ',IPAR,'->',PARCPO(IPAR),NITMA
            ELSE IF(PARFMT(IPAR).EQ.'STRING') THEN
               IF(NVALUE(IPAR).GT.MAXVAL) CALL XABORT('COMSDB: MAXVAL '
     1         //'OVERFLOW.')
               CALL LCMGTC(IPCPO,RECNAM,12,NVALUE(IPAR),VCHAR)
               TEXT12=VCHAR(IVAL)
               write(6,*)'IPAR ',IPAR,'->',PARCPO(IPAR),TEXT12
            ENDIF
  100    CONTINUE
         CALL LCMSIX(IPCPO,' ',2)
*----
*  RECOVER THE LOCAL PARAMETERS
*----
      CALL LCMSIX(KPCPO,'TREE',1)
      DO 130 ILOC=1,NLOC
         WRITE(RECNAM,'(''pval'',I8.8)') ILOC
         IVAL=MUPCPO(NPAR+ILOC)
         CALL LCMLEN(KPCPO,RECNAM,ILONG,ITYLCM)
         ALLOCATE(VREAL(ILONG))
         CALL LCMGET(KPCPO,RECNAM,VREAL)
         FLOTT=VREAL(IVAL)
         DEALLOCATE(VREAL)
         WRITE(6,*)'ILOC ',ILOC,'->',PARKEY(IPAR),FLOTT
  130 CONTINUE
      CALL LCMSIX(KPCPO,' ',2)
  170 CONTINUE
* END OF LOOP ON MIXTURES. ***********************************
      IF (IMPX.GT.1) GOTO 190
      WRITE(6,*) 'Summary of the parameter included in the COMPO'
         CALL LCMSIX(IPCPO,'GLOBAL',1)
         CALL LCMGTC(IPCPO,'PARKEY',12,NPAR,PARCPO)
         CALL LCMGTC(IPCPO,'PARFMT',8,NPAR,PARFMT)
         CALL LCMGET(IPCPO,'NVALUE',NVALUE)
         DO 180 IPAR=1,NPAR
            WRITE(RECNAM,'(''pval'',I8.8)') IPAR
            IF(PARFMT(IPAR).EQ.'REAL') THEN
               ALLOCATE(VREAL(NVALUE(IPAR)))
               CALL LCMGET(IPCPO,RECNAM,VREAL)
               WRITE(6,*)'IPAR ',IPAR,'->',PARKEY(IPAR),
     1                   (VREAL(JM),JM=1,NVALUE(IPAR))
               DEALLOCATE(VREAL)
            ELSE IF(PARFMT(IPAR).EQ.'INTEGER') THEN
               ALLOCATE(VINTE(NVALUE(IPAR)))
               CALL LCMGET(IPCPO,RECNAM,VINTE)
               WRITE(6,*)'IPAR ',IPAR,'->',PARKEY(IPAR),
     1                   (VINTE(JM),JM=1,NVALUE(IPAR))
               DEALLOCATE(VINTE)
            ELSE IF(PARFMT(IPAR).EQ.'STRING') THEN
               IF(NVALUE(IPAR).GT.MAXVAL) CALL XABORT('COMSDB: MAXVAL '
     1         //'OVERFLOW.')
               CALL LCMGTC(IPCPO,RECNAM,12,NVALUE(IPAR),VCHAR)
               WRITE(6,*)'IPAR ',IPAR,'->',PARKEY(IPAR),
     1                   (VCHAR(JM),JM=1,NVALUE(IPAR))
            ENDIF
  180    CONTINUE
      CALL LCMSIX(KPCPO,'TREE',1)
      DO 185 ILOC=1,NLOC
         CALL LCMGTC(IPCPO,'PARKEL',12,NLOC,PARCPO)
         CALL LCMGET(IPCPO,'NVALUE',NVALUE)
         WRITE(RECNAM,'(''pval'',I8.8)') ILOC
         CALL LCMLEN(KPCPO,RECNAM,ILONG,ITYLCM)
         ALLOCATE(VREAL(ILONG))
         CALL LCMGET(KPCPO,RECNAM,VREAL)
         WRITE(6,*)'ILOC ',ILOC,'->',PARCPO(ILOC),
     1             (VREAL(JM),JM=1,NVALUE(ILOC))
         DEALLOCATE(VREAL)
  185 CONTINUE
      CALL LCMSIX(KPCPO,' ',2)
      
  190 CONTINUE
*
*      ENDIF
* END OF LOOP ON ELEMENTARY CALCULATIONS. ********************
*----
*  SCRATCH STORAGE DEALLOCATION
*----
      DEALLOCATE(MUPCPO)
      RETURN
      END
