1*----------------------------------------------------------------------- 2* ULIQNP / ULIQID / ULIQCP / ULIQVL / ULISVL 3*----------------------------------------------------------------------- 4* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. 5*----------------------------------------------------------------------- 6 SUBROUTINE ULIQNP(NCP) 7 8 CHARACTER CP*(*) 9 10 PARAMETER (NPARA = 4) 11 12 INTEGER IX(NPARA) 13 LOGICAL LCHREQ, LFIRST 14 CHARACTER CPARAS(NPARA)*8 15 CHARACTER CPARAL(NPARA)*40 16 CHARACTER CMSG*80 17 18 EXTERNAL LCHREQ, LENC 19 20 SAVE 21 22* / SHORT NAME / 23 24 DATA CPARAS(1) / 'IXCHR ' /, IX(1) / 195 / 25 DATA CPARAS(2) / 'IYCHR ' /, IX(2) / 195 / 26 DATA CPARAS(3) / 'IXTYPE ' /, IX(3) / 1 / 27 DATA CPARAS(4) / 'IYTYPE ' /, IX(4) / 1 / 28 29* / LONG NAME / 30 31 DATA CPARAL(1) / 'LOG_X_LABEL_CHAR' / 32 DATA CPARAL(2) / 'LOG_Y_LABEL_CHAR' / 33 DATA CPARAL(3) / '****IXTYPE ' / 34 DATA CPARAL(4) / '****IYTYPE ' / 35 36* IXCHR /IYCHR : CHARACTER NUMBER OF * FOR 5*10E1 IN X/Y-AXIS 37* IXTYPE/IXTYPE : 1-4 1 ... 10|2" 2*10|2" 5*10|2" 10|3" ETC 38* 2 ... 10|2" 2 5 10|3" ETC 39* 3 ... 100 200 500 1000 ETC 40* 4 ... 100 2 5 1000 ETC 41* FORMAT FOR 3 OR 4 DEPENDS ON THAT SET BY ULSFMT 42 43 DATA LFIRST / .TRUE. / 44 45 46 NCP = NPARA 47 48 RETURN 49*----------------------------------------------------------------------- 50 ENTRY ULIQID(CP, IDX) 51 52 DO 10 N = 1, NPARA 53 IF (LCHREQ(CP, CPARAS(N)) .OR. LCHREQ(CP, CPARAL(N))) THEN 54 IDX = N 55 RETURN 56 END IF 57 10 CONTINUE 58 CMSG = 'PARAMETER '''//CP(1:LENC(CP))//''' IS NOT DEFINED.' 59 CALL MSGDMP('E','ULIQID',CMSG) 60 61 RETURN 62*----------------------------------------------------------------------- 63 ENTRY ULIQCP(IDX, CP) 64 65 IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN 66 CP = CPARAS(IDX) 67 ELSE 68 CALL MSGDMP('E','ULIQCP','IDX IS OUT OF RANGE.') 69 END IF 70 71 RETURN 72*----------------------------------------------------------------------- 73 ENTRY ULIQCL(IDX, CP) 74 75 IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN 76 CP = CPARAL(IDX) 77 ELSE 78 CALL MSGDMP('E','ULIQCL','IDX IS OUT OF RANGE.') 79 END IF 80 81 RETURN 82*----------------------------------------------------------------------- 83 ENTRY ULIQVL(IDX, IPARA) 84 85 IF (LFIRST) THEN 86 CALL RTIGET('UL', CPARAS, IX, NPARA) 87 CALL RLIGET(CPARAL, IX, NPARA) 88 LFIRST = .FALSE. 89 END IF 90 91 IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN 92 IPARA = IX(IDX) 93 ELSE 94 CALL MSGDMP('E','ULIQVL','IDX IS OUT OF RANGE.') 95 END IF 96 97 RETURN 98*----------------------------------------------------------------------- 99 ENTRY ULISVL(IDX, IPARA) 100 101 IF (LFIRST) THEN 102 CALL RTIGET('UL', CPARAS, IX, NPARA) 103 CALL RLIGET(CPARAL, IX, NPARA) 104 LFIRST = .FALSE. 105 END IF 106 107 IF (1.LE.IDX .AND. IDX.LE.NPARA) THEN 108 IX(IDX) = IPARA 109 ELSE 110 CALL MSGDMP('E','ULISVL','IDX IS OUT OF RANGE.') 111 END IF 112 113 RETURN 114*----------------------------------------------------------------------- 115 ENTRY ULIQIN(CP, IN) 116 117 DO 20 N = 1, NPARA 118 IF (LCHREQ(CP, CPARAS(N)) .OR. LCHREQ(CP, CPARAL(N))) THEN 119 IN = N 120 RETURN 121 END IF 122 20 CONTINUE 123 124 IN = 0 125 126 RETURN 127 END 128