*-----------------------------------------------------------------------
*     DATEC3
*-----------------------------------------------------------------------
*     Copyright (C) 2000-2022 GFD Dennou Club. All rights reserved.
*-----------------------------------------------------------------------
      SUBROUTINE DATEC3(CFORM,IY,IM,ID)

      CHARACTER CFORM*(*)

      PARAMETER (NN=3)

      INTEGER   JD(NN)
      CHARACTER CD(NN)*1,CFMT*4,CMON*9,CWEEK*9

      SAVE

      EXTERNAL  LENC,INDXCF,INDXCL,CMON,CWEEK

      DATA      CD/'Y','M','D'/


      MC=LENC(CFORM)
      JD(1)=IY
      JD(2)=IM
      JD(3)=ID
      DO 10 I=1,3
        IDX1=INDXCF(CFORM,MC,1,CD(I))
        IDX2=INDXCL(CFORM,MC,1,CD(I))
        IF (IDX1.GT.0) THEN
          NCM=IDX2-IDX1+1
          WRITE(CFMT,'(A2,I1,A1)') '(I',NCM,')'
          WRITE(CFORM(IDX1:IDX2),CFMT) MOD(JD(I),10**NCM)
        END IF
   10 CONTINUE

      IDX1=INDXCF(CFORM,MC,1,'C')
      IDX2=INDXCL(CFORM,MC,1,'C')
      IF (IDX1.GT.0) THEN
        NCM=IDX2-IDX1+1
        WRITE(CFMT,'(A2,I1,A1)') '(A',NCM,')'
        WRITE(CFORM(IDX1:IDX2),CFMT) CMON(JD(2))
        CALL CRADJ(CFORM(IDX1:IDX2))
      END IF

      IDX1=INDXCF(CFORM,MC,1,'W')
      IDX2=INDXCL(CFORM,MC,1,'W')
      IF (IDX1.GT.0) THEN
        NCW=IDX2-IDX1+1
        WRITE(CFMT,'(A2,I1,A1)') '(A',NCW,')'
        WRITE(CFORM(IDX1:IDX2),CFMT) CWEEK(IWEEK3(IY,IM,ID))
        CALL CRADJ(CFORM(IDX1:IDX2))
      END IF

      END
