*----------------------------------------------------------------------- * GLCQNP / GLCQID / GLCQCP / GLCQVL / GLCSVL *----------------------------------------------------------------------- SUBROUTINE GLCQNP(NCP) CHARACTER CP*(*), CVAL*(*) PARAMETER (NPARA = 3) LOGICAL LCHREQ, LFIRST CHARACTER CPARAS(NPARA)*8 CHARACTER CPARAL(NPARA)*40 CHARACTER CX(NPARA)*80, CMSG*80 EXTERNAL LCHREQ, LENC SAVE * ---- SHORT NAME ---- DATA CPARAS( 1)/'DCLRC '/, CX( 1)/'dclrc '/ DATA CPARAS( 2)/'DUPATH '/, CX( 2)/' '/ DATA CPARAS( 3)/'DSPATH '/, CX( 3)/ + 'c:\dennou\dbase\' / * ---- LONG NAME ---- DATA CPARAL( 1)/'DCLRC '/ DATA CPARAL( 2)/'USER_DATABASE_DIR'/ DATA CPARAL( 3)/'****DSPATH '/ DATA LFIRST /.TRUE./ NCP = NPARA RETURN *----------------------------------------------------------------------- ENTRY GLCQID(CP, IDX) DO 10 N = 1, NPARA IF (LCHREQ(CP,CPARAS(N)) .OR. & LCHREQ(CP,CPARAL(N))) THEN IDX = N RETURN END IF 10 CONTINUE CMSG = 'PARAMETER '''//CP(1:LENC(CP))//''' IS NOT DEFINED.' CALL MSGDMP('E', 'GLCQID', CMSG) RETURN *----------------------------------------------------------------------- ENTRY GLCQCP(IDX, CP) IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN CP = CPARAS(IDX) ELSE CALL MSGDMP('E', 'GLCQCP', 'IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY GLCQCL(IDX, CP) IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN CP = CPARAL(IDX) ELSE CALL MSGDMP('E', 'GLCQCP', 'IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY GLCQVL(IDX, CVAL) IF (LFIRST) THEN CALL RTCGET('GL:', CPARAS, CX, NPARA) CALL RLCGET(CPARAL, CX, NPARA) LFIRST = .FALSE. END IF IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN CVAL = CX(IDX) ELSE CALL MSGDMP('E', 'GLCQVL', 'IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY GLCSVL(IDX, CVAL) IF (LFIRST) THEN CALL RTCGET('GL:', CPARAS, CX, NPARA) CALL RLCGET(CPARAL, CX, NPARA) LFIRST = .FALSE. END IF IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN CX(IDX) = CVAL ELSE CALL MSGDMP('E', 'GLCSVL', 'IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY GLCQIN(CP, IN) DO 20 N = 1, NPARA IF (LCHREQ(CP, CPARAS(N)) .OR. & LCHREQ(CP, CPARAL(N))) THEN IN = N RETURN ENDIF 20 CONTINUE IN = 0 RETURN END