*-----------------------------------------------------------------------
*     CHVAL
*-----------------------------------------------------------------------
*     Copyright (C) 2000-2022 GFD Dennou Club. All rights reserved.
*-----------------------------------------------------------------------
      SUBROUTINE CHVAL(CFMT,VAL,CVAL)

*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*
*     THIS ROUTINE RETURNS CHARACTERIZED VALUE "CVAL" OF "VAL" USING
*     USER SPECIFIED FORMAT "CFMT". IF ONE OF THE FOLLOWING OPTINONS IS
*     SPECIFIED AS "CFMT", FORMAT WILL BE GENERATED AUTOMATICALLY TO
*     REPRESENT 3 SIGNIFICANT DIGITS.
*
*     CFMT   (C*(*)) : FORMAT OR OPTION NAME (I/ ).
*                    : FORMAT SHOULD BEGIN WITH '('.
*                    : ONE OF THE FOLLOWING OPTIONS CAN BE SPECIFIED.
*                    : 'A' - FORMAT IS SET AUTOMATICALLY.
*                    : 'B' - 'A' AND TRAILING ZERO AND DECIMAL POINT ARE
*                    :       DELETED.
*                    : 'C' - 'B' AND ZERO BEFORE DECIMAL POINT AND '+'
*                    :       ARE DELETED.
*                    : 'D' - 'C' BUT ONLY FOR THE EXPONENT TYPE.
*     VAL    (R)     : NUMERIC VALUE THAT SHOULD BE CHARACTERIZED (I/ ).
*     CVAL   (C*(*)) : CHARACTERIZED VALUE OF "VAL" ( /O).
*                    : LEN(CVAL) SHOULD BE 8 OR MORE.
*
*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

      CHARACTER CFMT*(*),CVAL*(*)

      CHARACTER CFMTX*16,CHX*16,CF*1,COPT*3
      LOGICAL   LFRST,LCHREQ,LON,LAT

      SAVE

      EXTERNAL  LCHREQ,LENC,INDXCF,RMOD

      DATA      LFRST/.TRUE./


*     / CHECK LENGTH OF OUTPUT CHARACTER /

      IF (LEN(CVAL).LT.8 .AND. LFRST) THEN
        CALL MSGDMP('W','CHVAL ','LENGTH OF CHARACTER IS LESS THAN 8.')
        LFRST=.FALSE.
      END IF

*     / CHECK MAIN OPTION /

      CF=CFMT(1:1)
      CALL CUPPER(CF)

*     / CHECK SUB OPTION /

      NC=LENC(CFMT)
      LON=.FALSE.
      LAT=.FALSE.
      IF (NC.GE.3) THEN
        IF (CFMT(2:2).EQ.'+') THEN
          COPT=CFMT(3:NC)
          IF (LCHREQ(COPT,'X') .OR. LCHREQ(COPT,'LON')) THEN
            LON=.TRUE.
          ELSE IF (LCHREQ(COPT,'Y') .OR. LCHREQ(COPT,'LAT')) THEN
            LAT=.TRUE.
          END IF
        END IF
      END IF

      IF (CF.NE.'(') THEN

*       / LONGITUDE (X) OR LATITUDE (Y) OPTION /

        IF (LON) THEN
          VALZ=RMOD(VAL+180,360.0)-180
        ELSE IF (LAT) THEN
          VALZ=VAL
        ELSE
          VALZ=VAL
        END IF

*       / AUTOMATIC GENERATION (NOT USER FORMAT) /

*       / PICK UP 3 SIGNIFICANT DIGITS AND EXPONENT /

        CFMTX='(1P,E9.2E2)'
        WRITE(CHX,CFMTX) VALZ
        READ(CHX(7:9),'(I3)') IE
        READ(CHX(1:5),'(F5.2)') RB
        VALX=RB*10.0**IE

*       / FORMAT /

        IF (0.LE.IE .AND. IE.LE.2) THEN

*         / DECIMAL /

          CFMTX='(F6. )'
          WRITE(CFMTX(5:5),'(I1)') 2-IE

        ELSE IF (3.LE.IE .AND. IE.LE.4) THEN

*         / INTEGER /

          CFMTX='(I6)'

        ELSE IF (-3.LE.IE .AND. IE.LE.-1) THEN

*         / DECIMAL OR EXPONENT /

*         / COUNT TRAILING ZERO /

          NZ=0
   10     IF (.NOT.(CHX(5-NZ:5-NZ).EQ.'0')) GO TO 15
            NZ=NZ+1
            GO TO 10
   15     CONTINUE

*         / IF -IE .LE. TRAILING ZERO +1 THEN DECIMAL ELSE EXPONENT /

          IF (-IE.LE.NZ) THEN
            CFMTX='(F6.2)'
          ELSE IF (-IE.LE.NZ+1) THEN
            CFMTX='(F6.3)'
          ELSE
            CFMTX='(1P,E8.2E1)'
          END IF

        ELSE IF (-9.LE.IE .AND. IE.LE.9) THEN

*         / EXPONENT ( SIGNIFICANT DIGITS = 3 ) /

          CFMTX='(1P,E8.2E1)'

        ELSE

*         / EXPONENT ( SIGNIFICANT DIGITS = 2 ) /

          CFMTX='(1P,E8.1E2)'

        END IF

      ELSE

*       / USER FORMAT /

        CFMTX=CFMT
        VALX=VAL

      END IF

*     / ENCODING /

      CHX=' '
      IF (LCHREQ(CFMTX(2:2),'I')) THEN
        WRITE(CHX,CFMTX) NINT(VALX)
      ELSE
        WRITE(CHX,CFMTX) VALX
      END IF

*     / CHECK BLANK BEFORE DECIMAL POINT (SYSTEM DEPENDENT) /

      IDXDC=INDXCF(CHX,LENC(CHX),1,'.')
      IF (IDXDC.NE.0) THEN
        ID1=IDXDC-1
        IF (CHX(ID1:ID1).EQ.' ') THEN
          CHX(ID1:ID1)='0'
        ELSE IF (CHX(ID1:ID1).EQ.'-') THEN
          CHX(ID1-1:ID1)='-0'
        END IF
      END IF

*     / LEFT ADJUST /

      CALL CLADJ(CHX)
      NC=LENC(CHX)
      IF (CHX(1:1).EQ.'+') THEN
        CVAL(1:NC-1)=CHX(2:NC)
        NC=NC-1
        CHX=CVAL(1:NC)
      END IF

*     / OPTION /

      IF (((CF.EQ.'B' .OR. CF.EQ.'C') .AND. INDXCF(CHX,NC,1,'.').NE.0)
     +  .OR. (CF.EQ.'D' .AND. INDXCF(CHX,NC,1,'E').NE.0)) THEN

*       / DELETE TRAILING ZERO AND DECIMAL POINT /

*       / CHECK EXPONENT OR DECIMAL /

        IDE=INDXCF(CHX,NC,1,'E')
        IF (IDE.EQ.0) THEN
*         / DECIMAL /
          MC=NC
        ELSE
*         / EXPONENT /
          MC=IDE-1
        END IF

*       / COUNT TRAILING ZERO /

   25   IF (.NOT.(CHX(MC:MC).EQ.'0')) GO TO 20
          MC=MC-1
          GO TO 25
   20   CONTINUE

*       / CHECK DECIMAL POINT /

        IF (CHX(MC:MC).EQ.'.') THEN
          MC=MC-1
        END IF

*       / AVAILABLE LENGTH /

        IF (IDE.EQ.0) THEN
          NC=MC
        ELSE
          CVAL=CHX(1:MC)//CHX(IDE:NC)
          NC=MC+NC-IDE+1
          CHX(1:NC)=CVAL(1:NC)
        END IF

*       / 'C' & 'D' OPTION /

        IF ((CF.EQ.'C' .OR. CF.EQ.'D') .AND. NC.GT.1) THEN

*         / DELETE ZERO BEFORE DECIMAL POINT /

          IF (CHX(1:1).EQ.'0') THEN
            CVAL=CHX(2:NC)
            NC=NC-1
            CHX(1:NC)=CVAL(1:NC)
          ELSE IF (CHX(1:1).EQ.'-' .AND. CHX(2:2).EQ.'0') THEN
            CVAL=CHX(1:1)//CHX(3:NC)
            NC=NC-1
            CHX(1:NC)=CVAL(1:NC)
          END IF

*         / DELETE '+' IN EXPONENT PART /

          IDP=INDXCF(CHX,NC,1,'+')
          IF (IDP.NE.0) THEN
            CVAL(1:NC-1)=CHX(1:IDP-1)//CHX(IDP+1:NC)
            NC=NC-1
            CHX(1:NC)=CVAL(1:NC)
          END IF

        END IF

      END IF

*     / RETURN CHARACTER /

      IF (CF.NE.'(') THEN
        IF (LON) THEN
          IF (VALZ.EQ.0 .OR. VALZ.EQ.-180) THEN
            IF (VALZ.EQ.0) THEN
              CVAL=CHX(1:NC)
            ELSE IF (VALZ.EQ.-180) THEN
              CVAL=CHX(2:NC)
            END IF
          ELSE
            IF (CHX(1:1).EQ.'-') THEN
              CVAL=CHX(2:NC)//'W'
            ELSE
              CVAL=CHX(1:NC)//'E'
            END IF
          END IF
        ELSE IF (LAT) THEN
          IF (VALZ.EQ.0) THEN
*           CVAL=CHX(1:NC)
            CVAL='EQ'
          ELSE
            IF (CHX(1:1).EQ.'-') THEN
              CVAL=CHX(2:NC)//'S'
            ELSE
              CVAL=CHX(1:NC)//'N'
            END IF
          END IF
        ELSE
          CVAL=CHX(1:NC)
          CALL CLOWER(CVAL)
        END IF
      ELSE
        CVAL=CHX(1:NC)
        CALL CLOWER(CVAL)
      END IF

      END
