*----------------------------------------------------------------------- * UMLQNP / UMLQID / UMLQCP / UMLQVL / UMLSVL *----------------------------------------------------------------------- * Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. *----------------------------------------------------------------------- SUBROUTINE UMLQNP(NCP) LOGICAL LPARA CHARACTER CP*(*) PARAMETER (NPARA = 5) LOGICAL LX(NPARA) LOGICAL LCHREQ, LFIRST CHARACTER CPARAS(NPARA)*8 CHARACTER CPARAL(NPARA)*40 CHARACTER CMSG*80 EXTERNAL LCHREQ, LENC SAVE * / SHORT NAME / DATA CPARAS(1) / 'LGRIDMJ ' /, LX(1) / .TRUE. / DATA CPARAS(2) / 'LGRIDMN ' /, LX(2) / .TRUE. / DATA CPARAS(3) / 'LGLOBE ' /, LX(3) / .FALSE. / DATA CPARAS(4) / 'LWHINT ' /, LX(4) / .TRUE. / DATA CPARAS(5) / 'LFILLAKE' /, LX(5) / .FALSE. / * / LONG NAME / DATA CPARAL(1) / 'ENABLE_MAP_MAJOR_LINE' / DATA CPARAL(2) / 'ENABLE_MAP_MINOR_LINE' / DATA CPARAL(3) / 'ENABLE_GLOBAL_MAPPING' / DATA CPARAL(4) / '----LWHINT ' / DATA CPARAL(5) / 'ENABLE_PAINT_LAKE' / DATA LFIRST / .TRUE. / NCP = NPARA RETURN *----------------------------------------------------------------------- ENTRY UMLQID(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','UMLQID',CMSG) RETURN *----------------------------------------------------------------------- ENTRY UMLQCP(IDX, CP) IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN CP = CPARAS(IDX) ELSE CALL MSGDMP('E','UMLQCP','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY UMLQCL(IDX, CP) IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN CP = CPARAL(IDX) ELSE CALL MSGDMP('E','UMLQCL','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY UMLQVL(IDX, LPARA) IF (LFIRST) THEN CALL RTLGET('UM', CPARAS, LX, NPARA) CALL RLLGET(CPARAL, LX, NPARA) LFIRST = .FALSE. END IF IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN LPARA = LX(IDX) ELSE CALL MSGDMP('E','UMLQVL','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY UMLSVL(IDX, LPARA) IF (LFIRST) THEN CALL RTLGET('UM', CPARAS, LX, NPARA) CALL RLLGET(CPARAL, LX, NPARA) LFIRST = .FALSE. END IF IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN LX(IDX) = LPARA ELSE CALL MSGDMP('E','UMLSVL','IDX IS OUT OF RANGE.') END IF RETURN *----------------------------------------------------------------------- ENTRY UMLQIN(CP, IN) DO 20 N = 1, NPARA IF (LCHREQ(CP, CPARAS(N)) .OR. LCHREQ(CP, CPARAL(N))) THEN IN = N RETURN END IF 20 CONTINUE IN = 0 RETURN END