*-----------------------------------------------------------------------
*     Copyright (C) 2000-2022 GFD Dennou Club. All rights reserved.
*-----------------------------------------------------------------------
      PROGRAM DCLPAR

      LOGICAL   LCHREQ
      CHARACTER CGRP*3

      EXTERNAL  LCHREQ
      EXTERNAL  GLPQNP,GLPQCP,GLPQVL
      EXTERNAL  GLCQNP,GLCQCP,GLCQVL
      EXTERNAL  SGPQNP,SGPQCP,SGPQVL
      EXTERNAL  SWPQNP,SWPQCP,SWPQVL
      EXTERNAL  SWCQNP,SWCQCP,SWCQVL
      EXTERNAL  UCPQNP,UCPQCP,UCPQVL
      EXTERNAL  UDPQNP,UDPQCP,UDPQVL
      EXTERNAL  UEPQNP,UEPQCP,UEPQVL
      EXTERNAL  UGPQNP,UGPQCP,UGPQVL
      EXTERNAL  ULPQNP,ULPQCP,ULPQVL
      EXTERNAL  UMPQNP,UMPQCP,UMPQVL
      EXTERNAL  USPQNP,USPQCP,USPQVL
      EXTERNAL  UZPQNP,UZPQCP,UZPQVL


      CALL OSQARN(NP)
      IF (NP.EQ.0) THEN
        CALL GLIGET('IIUNIT',II)
        CALL GLIGET('IOUNIT',IO)
        WRITE(IO,*) ' GROUP NAME (C*3) (EX. GLP) ? ;'
        READ(II,*) CGRP
      ELSE
        CALL OSGARG(1,CGRP)
      END IF

      IF (LCHREQ(CGRP,'GLP')) THEN
        CALL DCLPPZ(GLPQNP,GLPQCP,GLPQVL)
      ELSE IF (LCHREQ(CGRP,'GLC')) THEN
        CALL DCLCPZ(GLCQNP,GLCQCP,GLCQVL)
      ELSE IF (LCHREQ(CGRP,'SGP')) THEN
        CALL DCLPPZ(SGPQNP,SGPQCP,SGPQVL)
      ELSE IF (LCHREQ(CGRP,'SWP')) THEN
        CALL DCLPPZ(SWPQNP,SWPQCP,SWPQVL)
      ELSE IF (LCHREQ(CGRP,'SWC')) THEN
        CALL DCLCPZ(SWCQNP,SWCQCP,SWCQVL)
      ELSE IF (LCHREQ(CGRP,'UCP')) THEN
        CALL DCLPPZ(UCPQNP,UCPQCP,UCPQVL)
      ELSE IF (LCHREQ(CGRP,'UDP')) THEN
        CALL DCLPPZ(UDPQNP,UDPQCP,UDPQVL)
      ELSE IF (LCHREQ(CGRP,'UEP')) THEN
        CALL DCLPPZ(UEPQNP,UEPQCP,UEPQVL)
      ELSE IF (LCHREQ(CGRP,'UGP')) THEN
        CALL DCLPPZ(UGPQNP,UGPQCP,UGPQVL)
      ELSE IF (LCHREQ(CGRP,'ULP')) THEN
        CALL DCLPPZ(ULPQNP,ULPQCP,ULPQVL)
      ELSE IF (LCHREQ(CGRP,'UMP')) THEN
        CALL DCLPPZ(UMPQNP,UMPQCP,UMPQVL)
      ELSE IF (LCHREQ(CGRP,'USP')) THEN
        CALL DCLPPZ(USPQNP,USPQCP,USPQVL)
      ELSE IF (LCHREQ(CGRP,'UZP')) THEN
        CALL DCLPPZ(UZPQNP,UZPQCP,UZPQVL)
      END IF

      END
*-----------------------------------------------------------------------
      SUBROUTINE DCLPPZ(XXPQNP,XXPQCP,XXPQVL)

      LOGICAL   LP
      CHARACTER CP*8,CP1*1

      EQUIVALENCE (IP,RP,LP)


      CALL GLIGET('IOUNIT',IU)

      CALL XXPQNP(NCP)
      DO 10 N=1,NCP
        CALL XXPQCP(N,CP)
        CALL XXPQVL(N,IP)
        CP1=CP(1:1)
        CALL CUPPER(CP1)
        IF (      CP1.EQ.'I' .OR. CP1.EQ.'J' .OR. CP1.EQ.'K'
     +       .OR. CP1.EQ.'M' .OR. CP1.EQ.'N' ) THEN
          WRITE(IU,'(A8,A3,I10)') CP,' = ',IP
        ELSE IF ( CP1.EQ.'L') THEN
          WRITE(IU,'(A8,A3,L10)') CP,' = ',LP
        ELSE
          WRITE(IU,'(A8,A3,1P,E16.8)') CP,' = ',RP
        END IF
   10 CONTINUE

      END
*-----------------------------------------------------------------------
      SUBROUTINE DCLCPZ(XXCQNP,XXCQCP,XXCQVL)

      LOGICAL   LP
      CHARACTER CP*8,CPARA*1024

      EQUIVALENCE (IP,RP,LP)


      CALL GLIGET('IOUNIT',IU)

      CALL XXCQNP(NCP)
      DO 10 N=1,NCP
        CALL XXCQCP(N,CP)
        CALL XXCQVL(N,CPARA)
        WRITE(IU,'(A8,A3,A)') CP,' = ',CPARA(1:LENC(CPARA))
   10 CONTINUE

      END
