1*----------------------------------------------------------------------- 2* UMLQNP / UMLQID / UMLQCP / UMLQVL / UMLSVL 3*----------------------------------------------------------------------- 4* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. 5*----------------------------------------------------------------------- 6 SUBROUTINE UMLQNP(NCP) 7 8 LOGICAL LPARA 9 CHARACTER CP*(*) 10 11 PARAMETER (NPARA = 5) 12 13 LOGICAL LX(NPARA) 14 LOGICAL LCHREQ, LFIRST 15 CHARACTER CPARAS(NPARA)*8 16 CHARACTER CPARAL(NPARA)*40 17 CHARACTER CMSG*80 18 19 EXTERNAL LCHREQ, LENC 20 21 SAVE 22 23* / SHORT NAME / 24 25 DATA CPARAS(1) / 'LGRIDMJ ' /, LX(1) / .TRUE. / 26 DATA CPARAS(2) / 'LGRIDMN ' /, LX(2) / .TRUE. / 27 DATA CPARAS(3) / 'LGLOBE ' /, LX(3) / .FALSE. / 28 DATA CPARAS(4) / 'LWHINT ' /, LX(4) / .TRUE. / 29 DATA CPARAS(5) / 'LFILLAKE' /, LX(5) / .FALSE. / 30 31* / LONG NAME / 32 33 DATA CPARAL(1) / 'ENABLE_MAP_MAJOR_LINE' / 34 DATA CPARAL(2) / 'ENABLE_MAP_MINOR_LINE' / 35 DATA CPARAL(3) / 'ENABLE_GLOBAL_MAPPING' / 36 DATA CPARAL(4) / '----LWHINT ' / 37 DATA CPARAL(5) / 'ENABLE_PAINT_LAKE' / 38 39 DATA LFIRST / .TRUE. / 40 41 42 NCP = NPARA 43 44 RETURN 45*----------------------------------------------------------------------- 46 ENTRY UMLQID(CP, IDX) 47 48 DO 10 N = 1, NPARA 49 IF (LCHREQ(CP, CPARAS(N)) .OR. LCHREQ(CP, CPARAL(N))) THEN 50 IDX = N 51 RETURN 52 END IF 53 10 CONTINUE 54 CMSG = 'PARAMETER '''//CP(1:LENC(CP))//''' IS NOT DEFINED.' 55 CALL MSGDMP('E','UMLQID',CMSG) 56 57 RETURN 58*----------------------------------------------------------------------- 59 ENTRY UMLQCP(IDX, CP) 60 61 IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN 62 CP = CPARAS(IDX) 63 ELSE 64 CALL MSGDMP('E','UMLQCP','IDX IS OUT OF RANGE.') 65 END IF 66 67 RETURN 68*----------------------------------------------------------------------- 69 ENTRY UMLQCL(IDX, CP) 70 71 IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN 72 CP = CPARAL(IDX) 73 ELSE 74 CALL MSGDMP('E','UMLQCL','IDX IS OUT OF RANGE.') 75 END IF 76 77 RETURN 78*----------------------------------------------------------------------- 79 ENTRY UMLQVL(IDX, LPARA) 80 81 IF (LFIRST) THEN 82 CALL RTLGET('UM', CPARAS, LX, NPARA) 83 CALL RLLGET(CPARAL, LX, NPARA) 84 LFIRST = .FALSE. 85 END IF 86 87 IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN 88 LPARA = LX(IDX) 89 ELSE 90 CALL MSGDMP('E','UMLQVL','IDX IS OUT OF RANGE.') 91 END IF 92 93 RETURN 94*----------------------------------------------------------------------- 95 ENTRY UMLSVL(IDX, LPARA) 96 97 IF (LFIRST) THEN 98 CALL RTLGET('UM', CPARAS, LX, NPARA) 99 CALL RLLGET(CPARAL, LX, NPARA) 100 LFIRST = .FALSE. 101 END IF 102 103 IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN 104 LX(IDX) = LPARA 105 ELSE 106 CALL MSGDMP('E','UMLSVL','IDX IS OUT OF RANGE.') 107 END IF 108 109 RETURN 110*----------------------------------------------------------------------- 111 ENTRY UMLQIN(CP, IN) 112 113 DO 20 N = 1, NPARA 114 IF (LCHREQ(CP, CPARAS(N)) .OR. LCHREQ(CP, CPARAL(N))) THEN 115 IN = N 116 RETURN 117 END IF 118 20 CONTINUE 119 120 IN = 0 121 122 RETURN 123 END 124