[15] | 1 | PROGRAM fparser |
---|
| 2 | !$Id$ |
---|
| 3 | |
---|
| 4 | USE stringop |
---|
| 5 | |
---|
| 6 | IMPLICIT NONE |
---|
| 7 | ! |
---|
| 8 | ! |
---|
| 9 | ! Parses the code to create the Config.in Config.default and Config.help |
---|
| 10 | ! which are used by the tk shell. |
---|
| 11 | ! |
---|
| 12 | ! |
---|
| 13 | INTEGER nbkeymax, nbhelpmax, nbcasemax, nbsourmax, nbelmax |
---|
| 14 | PARAMETER (nbkeymax=100, nbhelpmax=50, nbcasemax=50, nbsourmax=20,nbelmax=nbhelpmax+10) |
---|
| 15 | INTEGER nbfilesmax |
---|
| 16 | PARAMETER (nbfilesmax=150) |
---|
| 17 | |
---|
| 18 | ! |
---|
| 19 | CHARACTER*120 :: configs(nbkeymax,nbelmax) |
---|
| 20 | CHARACTER*120 :: tmp_help, tmp_key, tmp_desc, tmp_def |
---|
| 21 | INTEGER :: keylen(nbkeymax), nbkeys |
---|
| 22 | INTEGER :: key_pos(nbkeymax), help_pos(nbkeymax,2), def_pos(nbkeymax,2) |
---|
| 23 | INTEGER :: des_pos(nbkeymax), IF_pos(nbkeymax) |
---|
| 24 | CHARACTER*6 TYPE_op(nbkeymax) |
---|
| 25 | ! |
---|
| 26 | CHARACTER*120 :: def_out(nbkeymax, nbhelpmax) |
---|
| 27 | INTEGER :: nbdef_out(nbkeymax) |
---|
| 28 | ! |
---|
| 29 | CHARACTER*120 :: tke |
---|
| 30 | ! |
---|
| 31 | CHARACTER*2 :: nbstr |
---|
| 32 | ! |
---|
| 33 | CHARACTER*80 :: files(nbfilesmax), source(nbsourmax), filetmp |
---|
| 34 | CHARACTER*80 :: tmp, main_name |
---|
| 35 | CHARACTER*120 :: keycase(nbcasemax), tmp_CASE |
---|
| 36 | INTEGER :: nbcase, ii, find, nbsource |
---|
| 37 | LOGICAL :: next_source, next_name, last_or |
---|
| 38 | |
---|
| 39 | LOGICAL :: is_main, cont |
---|
| 40 | |
---|
| 41 | CHARACTER*1 :: backslash, simplequote, doublequote |
---|
| 42 | |
---|
| 43 | INTEGER :: ia, iread, iret, IFF, ih, nb_line, iv, id |
---|
| 44 | INTEGER :: ind_space, ind_comma, ind_USE |
---|
| 45 | INTEGER :: nbfiles, nb_key, nb_key_file |
---|
| 46 | ! |
---|
| 47 | INTEGER, EXTERNAL :: iargc, getarg |
---|
| 48 | ! |
---|
| 49 | ! |
---|
| 50 | next_source = .FALSE. |
---|
| 51 | next_name = .FALSE. |
---|
| 52 | is_main = .FALSE. |
---|
| 53 | nbsource = 0 |
---|
| 54 | nbfiles = 0 |
---|
| 55 | main_name = 'IPSL' |
---|
| 56 | ! |
---|
| 57 | backslash = ACHAR(92) |
---|
| 58 | simplequote = ACHAR(39) |
---|
| 59 | doublequote = ACHAR(34) |
---|
| 60 | ! |
---|
| 61 | ! |
---|
| 62 | ! |
---|
| 63 | ! Analyse command line |
---|
| 64 | ! |
---|
| 65 | ! |
---|
| 66 | ! Get the number of arguments, that is the options and the |
---|
| 67 | ! files to be parsed. |
---|
| 68 | ! |
---|
| 69 | ! |
---|
| 70 | |
---|
| 71 | iread = iargc() |
---|
| 72 | ! |
---|
| 73 | DO ia=1,iread |
---|
| 74 | ! |
---|
| 75 | iret = getarg(ia,tmp) |
---|
| 76 | ! |
---|
| 77 | IF (next_source) THEN |
---|
| 78 | |
---|
| 79 | nbsource = nbsource + 1 |
---|
| 80 | IF ( nbsource .GT. nbsourmax) THEN |
---|
| 81 | WRITE(*,*) 'Too many files to source in the arguments.' |
---|
| 82 | WRITE(*,*) 'Increase nbsourmax' |
---|
| 83 | STOP |
---|
| 84 | ELSE |
---|
| 85 | source(nbsource) = tmp(1:LEN_TRIM(tmp)) |
---|
| 86 | ENDIF |
---|
| 87 | next_source = .FALSE. |
---|
| 88 | |
---|
| 89 | ELSE IF (next_name) THEN |
---|
| 90 | main_name = tmp(1:LEN_TRIM(tmp)) |
---|
| 91 | next_name = .FALSE. |
---|
| 92 | |
---|
| 93 | ELSE |
---|
| 94 | ! |
---|
| 95 | IF ( INDEX(tmp,'-m') .GT. 0) THEN |
---|
| 96 | is_main = .TRUE. |
---|
| 97 | ELSE IF ( INDEX(tmp,'-n') .GT. 0) THEN |
---|
| 98 | next_name = .TRUE. |
---|
| 99 | ELSE IF ( INDEX(tmp,'-s') .GT. 0) THEN |
---|
| 100 | next_source = .TRUE. |
---|
| 101 | ELSE IF ( INDEX(tmp,'-h') .GT. 0) THEN |
---|
| 102 | WRITE(*,*) 'USAGE : Fparse [-name NAME] ' |
---|
| 103 | WRITE(*,*) ' [-source file_to_source]' |
---|
| 104 | WRITE(*,*) ' [-main] FORTAN_files' |
---|
| 105 | ELSE |
---|
| 106 | nbfiles = nbfiles + 1 |
---|
| 107 | IF ( nbfiles .GT. nbfilesmax) THEN |
---|
| 108 | WRITE(*,*) 'Too many files to include in & |
---|
| 109 | & the arguments.' |
---|
| 110 | WRITE(*,*) 'Increase nbfilesmax' |
---|
| 111 | STOP |
---|
| 112 | ELSE |
---|
| 113 | files(nbfiles) = tmp(1:LEN_TRIM(tmp)) |
---|
| 114 | ENDIF |
---|
| 115 | ENDIF |
---|
| 116 | |
---|
| 117 | ENDIF |
---|
| 118 | |
---|
| 119 | ENDDO |
---|
| 120 | ! |
---|
| 121 | IF ( nbfiles .LT. 1 ) THEN |
---|
| 122 | WRITE(*,*) 'No files provided' |
---|
| 123 | STOP |
---|
| 124 | ENDIF |
---|
| 125 | ! |
---|
| 126 | ! |
---|
| 127 | ! 1.0 Read files and extract the lines which we need |
---|
| 128 | ! |
---|
| 129 | ! |
---|
| 130 | nb_key = 0 |
---|
| 131 | ! |
---|
| 132 | DO IFF=1,nbfiles |
---|
| 133 | ! |
---|
| 134 | filetmp = files(IFF) |
---|
| 135 | CALL READ_from_file(filetmp, nbkeymax, nbelmax, configs, nb_key, keylen) |
---|
| 136 | ! |
---|
| 137 | ENDDO |
---|
| 138 | ! |
---|
| 139 | ! 2.0 Scan the information we have extracted from the file for the elements we need |
---|
| 140 | ! |
---|
| 141 | ! |
---|
| 142 | CALL analyse_configs(nbkeymax, nb_key, nbelmax, keylen, configs, key_pos, help_pos, def_pos, des_pos, IF_pos, TYPE_op) |
---|
| 143 | ! |
---|
| 144 | ! |
---|
| 145 | ! 3.0 Prepare the default values to put them in an array |
---|
| 146 | ! |
---|
| 147 | ! |
---|
| 148 | DO ia = 1,nb_key |
---|
| 149 | ! |
---|
| 150 | ! 3.1 Go to blank delimited lines |
---|
| 151 | ! |
---|
| 152 | nbdef_out(ia) = 0 |
---|
| 153 | ! |
---|
| 154 | DO ii=def_pos(ia,1), def_pos(ia,2) |
---|
| 155 | ! |
---|
| 156 | tmp_help = configs(ia,ii) |
---|
| 157 | ind_comma = INDEX(tmp_help(1:len_TRIM(tmp_help)),',') |
---|
| 158 | DO WHILE (ind_comma .GT. 0) |
---|
| 159 | tmp_help(ind_comma:ind_comma) = ' ' |
---|
| 160 | ind_comma = INDEX(tmp_help,',') |
---|
| 161 | ENDDO |
---|
| 162 | CALL cmpblank(tmp_help) |
---|
| 163 | configs(ia,ii) = tmp_help |
---|
| 164 | ! |
---|
| 165 | ! 3.2 extract the values |
---|
| 166 | ! |
---|
| 167 | tmp_help = TRIM(ADJUSTL(configs(ia,ii))) |
---|
| 168 | ind_space= INDEX(tmp_help(1:LEN_TRIM(tmp_help)),' ') |
---|
| 169 | ! Get the first one (there is no space in between) |
---|
| 170 | IF ( ind_space .EQ. 0) THEN |
---|
| 171 | nbdef_out(ia) = nbdef_out(ia) + 1 |
---|
| 172 | def_out(ia, nbdef_out(ia)) = tmp_help(1:LEN_TRIM(tmp_help)) |
---|
| 173 | ELSE |
---|
| 174 | ! Get all those which are before spaces |
---|
| 175 | DO WHILE (ind_space .GT. 0) |
---|
| 176 | nbdef_out(ia) = nbdef_out(ia) + 1 |
---|
| 177 | def_out(ia, nbdef_out(ia)) = tmp_help(1:ind_space) |
---|
| 178 | tmp_help = ADJUSTL(tmp_help(ind_space+1:LEN_TRIM(tmp_help))) |
---|
| 179 | ind_space= INDEX(tmp_help(1:LEN_TRIM(tmp_help)),' ') |
---|
| 180 | ENDDO |
---|
| 181 | ! Get the last one which does not have a space behind |
---|
| 182 | IF ( LEN_TRIM(tmp_help) .GT. 0) THEN |
---|
| 183 | nbdef_out(ia) = nbdef_out(ia) + 1 |
---|
| 184 | def_out(ia, nbdef_out(ia)) = tmp_help(1:LEN_TRIM(tmp_help)) |
---|
| 185 | ENDIF |
---|
| 186 | ! |
---|
| 187 | ENDIF |
---|
| 188 | ENDDO |
---|
| 189 | ! |
---|
| 190 | ENDDO |
---|
| 191 | ! |
---|
| 192 | ! |
---|
| 193 | ! |
---|
| 194 | ! 4.0 OPEN Config.in Defaults and Help files |
---|
| 195 | ! |
---|
| 196 | ! |
---|
| 197 | OPEN (16, FILE='Config.in') |
---|
| 198 | OPEN (17, FILE='Config.help') |
---|
| 199 | OPEN (18, FILE='Config.defaults') |
---|
| 200 | ! |
---|
| 201 | ! Some explantation |
---|
| 202 | ! |
---|
| 203 | DO IFF=16,18 |
---|
| 204 | WRITE(IFF,'(1a)') '# ' |
---|
| 205 | WRITE(IFF,'(1a)') '# File created by Fparser, DO NOT EDIT' |
---|
| 206 | WRITE(IFF,'(2a)') '# ', main_name(1:LEN_TRIM(main_name)) |
---|
| 207 | WRITE(IFF,'(1a)') '# ' |
---|
| 208 | WRITE(IFF,'(1a)') '# ' |
---|
| 209 | ENDDO |
---|
| 210 | ! |
---|
| 211 | WRITE(17,'(2a)') '# Format of this file: description<nl>', & |
---|
| 212 | & ' variable<nl>helptext<nl><nl>.' |
---|
| 213 | WRITE(17,'(2a)') '# If the question being documented is of', & |
---|
| 214 | & ' type "choice", we list' |
---|
| 215 | WRITE(17,'(2a)') '# only the first occurring config variable.', & |
---|
| 216 | & ' The help texts' |
---|
| 217 | WRITE(17,'(2a)') '# must not contain empty lines. No variable', & |
---|
| 218 | & ' should occur twice; if it' |
---|
| 219 | WRITE(17,'(2a)') '# does, only the first occurrence will be', & |
---|
| 220 | & ' used by Configure. The lines' |
---|
| 221 | WRITE(17,'(2a)') '# in a help text should be indented two', & |
---|
| 222 | & ' positions. Lines starting with' |
---|
| 223 | WRITE(17,'(2a)') '# "#" are ignored. To be nice to menuconfig,', & |
---|
| 224 | & ' limit your lines to 70' |
---|
| 225 | WRITE(17,'(2a)') '# characters. Use emacs" kfill.el to edit', & |
---|
| 226 | & ' this file or you lose.' |
---|
| 227 | WRITE(17,'(2a)') '#' |
---|
| 228 | ! |
---|
| 229 | IF ( is_main ) THEN |
---|
| 230 | WRITE(16,'(3a)') 'mainmenu_name "Configuration of model ', & |
---|
| 231 | & main_name(1:LEN_TRIM(main_name)), '"' |
---|
| 232 | WRITE(16,'(1a)') '# ' |
---|
| 233 | ENDIF |
---|
| 234 | ! |
---|
| 235 | WRITE(16,'(1a)') 'mainmenu_option next_comment' |
---|
| 236 | WRITE(16,'(3a)') 'comment "', main_name(1:LEN_TRIM(main_name)), '"' |
---|
| 237 | WRITE(16,'(1a)') '# ' |
---|
| 238 | ! |
---|
| 239 | ! 5.0 Loop through the KEYWORDS to prepare the output |
---|
| 240 | ! |
---|
| 241 | DO IFF =1,nb_key |
---|
| 242 | ! |
---|
| 243 | ! Config.in file |
---|
| 244 | ! |
---|
| 245 | |
---|
| 246 | ! |
---|
| 247 | ! Is it a conditional option ? |
---|
| 248 | ! |
---|
| 249 | IF ( IF_pos(IFF) .GE. 0) THEN |
---|
| 250 | tmp_help = configs(IFF,IF_pos(IFF)) |
---|
| 251 | ! |
---|
| 252 | IF ( (index(tmp_help,'||') .LE. 0) .AND. (index(tmp_help,'&&') .LE. 0) ) THEN |
---|
| 253 | IF ( tmp_help(1:1) .EQ. '!') THEN |
---|
| 254 | WRITE(16,'(3a)') 'if [ "$', tmp_help(2:LEN_TRIM(tmp_help)), '" = "n" ]; then' |
---|
| 255 | ELSE |
---|
| 256 | WRITE(16,'(3a)') 'if [ "$', tmp_help(1:LEN_TRIM(tmp_help)), '" = "y" ]; then' |
---|
| 257 | ENDIF |
---|
| 258 | ELSE |
---|
| 259 | ! |
---|
| 260 | last_or = .TRUE. |
---|
| 261 | nbcase = 0 |
---|
| 262 | ! |
---|
| 263 | DO WHILE( INDEX(tmp_help,'||') .GT. 0) |
---|
| 264 | ii = INDEX(tmp_help,'||') |
---|
| 265 | nbcase = nbcase + 1 |
---|
| 266 | if ( nbcase .EQ. 1 ) THEN |
---|
| 267 | IF ( tmp_help(1:1) .EQ. '!') THEN |
---|
| 268 | WRITE(16,'(3a)') 'if [ "$', tmp_help(2:ii-1), '" = "n" \\' |
---|
| 269 | ELSE |
---|
| 270 | WRITE(16,'(3a)') 'if [ "$', tmp_help(1:ii-1), '" = "y" \\' |
---|
| 271 | ENDIF |
---|
| 272 | ELSE |
---|
| 273 | IF ( tmp_help(1:1) .EQ. '!') THEN |
---|
| 274 | WRITE(16,'(3a)') '-o "$', tmp_help(2:ii-1), '" = "n" \\' |
---|
| 275 | ELSE |
---|
| 276 | WRITE(16,'(3a)') '-o "$', tmp_help(1:ii-1), '" = "y" \\' |
---|
| 277 | ENDIF |
---|
| 278 | ENDIF |
---|
| 279 | tmp_help = TRIM(ADJUSTL(tmp_help(ii+2:LEN_TRIM(tmp_help)))) |
---|
| 280 | ENDDO |
---|
| 281 | ! |
---|
| 282 | DO WHILE( INDEX(tmp_help,'&&') .GT. 0) |
---|
| 283 | ii = INDEX(tmp_help,'&&') |
---|
| 284 | nbcase = nbcase + 1 |
---|
| 285 | if ( nbcase .EQ. 1 ) THEN |
---|
| 286 | IF ( tmp_help(1:1) .EQ. '!') THEN |
---|
| 287 | WRITE(16,'(3a)') 'if [ "$', tmp_help(2:ii-1), '" = "n" \\' |
---|
| 288 | ELSE |
---|
| 289 | WRITE(16,'(3a)') 'if [ "$', tmp_help(1:ii-1), '" = "y" \\' |
---|
| 290 | ENDIF |
---|
| 291 | ELSE |
---|
| 292 | IF ( tmp_help(1:1) .EQ. '!') THEN |
---|
| 293 | WRITE(16,'(3a)') '-a "$', tmp_help(2:ii-1), '" = "n" \\' |
---|
| 294 | ELSE |
---|
| 295 | WRITE(16,'(3a)') '-a "$', tmp_help(1:ii-1), '" = "y" \\' |
---|
| 296 | ENDIF |
---|
| 297 | ENDIF |
---|
| 298 | tmp_help = TRIM(ADJUSTL(tmp_help(ii+2:LEN_TRIM(tmp_help)))) |
---|
| 299 | last_or = .FALSE. |
---|
| 300 | ENDDO |
---|
| 301 | ! |
---|
| 302 | IF ( last_or ) THEN |
---|
| 303 | IF ( tmp_help(1:1) .EQ. '!') THEN |
---|
| 304 | WRITE(16,'(3a)') '-o "$', tmp_help(2:LEN_TRIM(tmp_help)), '" = "n" ]; then' |
---|
| 305 | ELSE |
---|
| 306 | WRITE(16,'(3a)') '-o "$', tmp_help(1:LEN_TRIM(tmp_help)), '" = "y" ]; then' |
---|
| 307 | ENDIF |
---|
| 308 | ELSE |
---|
| 309 | IF ( tmp_help(1:1) .EQ. '!') THEN |
---|
| 310 | WRITE(16,'(3a)') '-a "$', tmp_help(2:LEN_TRIM(tmp_help)), '" = "n" ]; then' |
---|
| 311 | ELSE |
---|
| 312 | WRITE(16,'(3a)') '-a "$', tmp_help(1:LEN_TRIM(tmp_help)), '" = "y" ]; then' |
---|
| 313 | ENDIF |
---|
| 314 | ENDIF |
---|
| 315 | ENDIF |
---|
| 316 | WRITE(16,'(1a)') ' ' |
---|
| 317 | ENDIF |
---|
| 318 | ! |
---|
| 319 | ! Extract the information from configs |
---|
| 320 | ! |
---|
| 321 | DO iv = 1,nbdef_out(IFF) |
---|
| 322 | |
---|
| 323 | IF (nbdef_out(IFF) .EQ. 1) THEN |
---|
| 324 | tmp_key = configs(IFF,key_pos(IFF)) |
---|
| 325 | tmp_desc = configs(IFF,des_pos(IFF)) |
---|
| 326 | tmp_def = def_out(IFF,iv) |
---|
| 327 | ELSE |
---|
| 328 | tmp_key = configs(IFF,key_pos(IFF)) |
---|
| 329 | WRITE(nbstr,'(I2.2)') iv |
---|
| 330 | tmp_key = tmp_key(1:LEN_TRIM(tmp_key))//'__'//nbstr |
---|
| 331 | tmp_desc = configs(IFF,des_pos(IFF)) |
---|
| 332 | IF ( iv .EQ. 1) THEN |
---|
| 333 | tmp_desc = tmp_desc(1:LEN_TRIM(tmp_desc))//' (Vector)' |
---|
| 334 | ELSE |
---|
| 335 | tmp_desc = 'Cont... '//tmp_key(1:LEN_TRIM(tmp_key)) |
---|
| 336 | ENDIF |
---|
| 337 | tmp_def = def_out(IFF,iv) |
---|
| 338 | ENDIF |
---|
| 339 | ! |
---|
| 340 | ! |
---|
| 341 | ! |
---|
| 342 | IF (INDEX(TYPE_op(IFF),'bool') .GT. 0) THEN |
---|
| 343 | ! |
---|
| 344 | WRITE(16,'(4a)') 'bool "', tmp_desc(1:LEN_TRIM(tmp_desc)), & |
---|
| 345 | & '" ',tmp_key(1:LEN_TRIM(tmp_key)) |
---|
| 346 | ! |
---|
| 347 | ELSE IF (INDEX(TYPE_op(IFF),'hex') .GT. 0) THEN |
---|
| 348 | ! |
---|
| 349 | WRITE(16,'(6a)') 'hex "', tmp_desc(1:LEN_TRIM(tmp_desc)) & |
---|
| 350 | & ,'" ',tmp_key(1:LEN_TRIM(tmp_key)) & |
---|
| 351 | & ,' ',tmp_def(1:LEN_TRIM(tmp_def)) |
---|
| 352 | ! |
---|
| 353 | ELSE IF (INDEX(TYPE_op(IFF),'choice') .GT. 0) THEN |
---|
| 354 | ! |
---|
| 355 | ! Get number of options |
---|
| 356 | ! |
---|
| 357 | nbcase = 0 |
---|
| 358 | DO WHILE( INDEX(tmp_key,'||') .GT. 0) |
---|
| 359 | ii = INDEX(tmp_key,'||') |
---|
| 360 | nbcase = nbcase + 1 |
---|
| 361 | keycase(nbcase) = tmp_key(1:ii-1) |
---|
| 362 | tmp_key=tmp_key(ii+2:LEN_TRIM(tmp_key)) |
---|
| 363 | ENDDO |
---|
| 364 | nbcase = nbcase + 1 |
---|
| 365 | keycase(nbcase) = tmp_key(1:LEN_TRIM(tmp_key)) |
---|
| 366 | |
---|
| 367 | WRITE(16,'(4a)') "choice '", tmp_desc(1:LEN_TRIM(tmp_desc))," '",backslash |
---|
| 368 | ! |
---|
| 369 | ! List options |
---|
| 370 | ! |
---|
| 371 | tmp_CASE = keycase(1) |
---|
| 372 | WRITE(16,'(5a)') ' "', tmp_CASE(1:LEN_TRIM(tmp_CASE)), " "& |
---|
| 373 | &,tmp_CASE(1:LEN_TRIM(tmp_CASE)), backslash |
---|
| 374 | ! |
---|
| 375 | DO ii=2,nbcase-1 |
---|
| 376 | tmp_CASE = keycase(ii) |
---|
| 377 | WRITE(16,'(5a)') ' ', tmp_CASE(1:LEN_TRIM(tmp_CASE)), ' ',& |
---|
| 378 | & tmp_CASE(1:LEN_TRIM(tmp_CASE)), backslash |
---|
| 379 | ENDDO |
---|
| 380 | ! |
---|
| 381 | tmp_CASE = keycase(nbcase) |
---|
| 382 | WRITE(16,'(6a)') ' ', & |
---|
| 383 | & tmp_CASE(1:LEN_TRIM(tmp_CASE)), & |
---|
| 384 | & ' ', tmp_CASE(1:LEN_TRIM(tmp_CASE)), & |
---|
| 385 | & '" ',tmp_def(1:LEN_TRIM(tmp_def)) |
---|
| 386 | ! |
---|
| 387 | ELSE |
---|
| 388 | WRITE(*,'(2a)') 'Uniplemented operation : ', TYPE_op(IFF) |
---|
| 389 | STOP |
---|
| 390 | ENDIF |
---|
| 391 | ! |
---|
| 392 | ! Config.help file |
---|
| 393 | ! |
---|
| 394 | tmp_key = configs(IFF,key_pos(IFF)) |
---|
| 395 | IF (INDEX(TYPE_op(IFF),'choice') .GT. 0) THEN |
---|
| 396 | ii = INDEX(tmp_key,'||')-1 |
---|
| 397 | ELSE |
---|
| 398 | ii = LEN_TRIM(tmp_key) |
---|
| 399 | ENDIF |
---|
| 400 | |
---|
| 401 | IF ( nbdef_out(IFF) .GT. 1) THEN |
---|
| 402 | WRITE(17,'(1a)') tmp_desc(1:LEN_TRIM(tmp_desc)) |
---|
| 403 | WRITE(nbstr,'(I2.2)') iv |
---|
| 404 | tke = tmp_key(1:ii)//'__'//nbstr |
---|
| 405 | WRITE(17,'(1a)') tke(1:LEN_TRIM(tke)) |
---|
| 406 | WRITE(17,'(1a)') ' (Vector)' |
---|
| 407 | ELSE |
---|
| 408 | WRITE(17,'(1a)') tmp_desc(1:LEN_TRIM(tmp_desc)) |
---|
| 409 | WRITE(17,'(1a)') tmp_key(1:ii) |
---|
| 410 | ENDIF |
---|
| 411 | ! |
---|
| 412 | DO ih=help_pos(IFF,1),help_pos(IFF,2) |
---|
| 413 | tmp_help = configs(IFF,ih) |
---|
| 414 | WRITE(17,'(" ",1a)') tmp_help(1:LEN_TRIM(tmp_help)) |
---|
| 415 | ENDDO |
---|
| 416 | ! |
---|
| 417 | ! Config.default file |
---|
| 418 | ! |
---|
| 419 | IF (INDEX(TYPE_op(IFF),'choice') .GT. 0) THEN |
---|
| 420 | |
---|
| 421 | WRITE(18,'(2a)') tmp_def(1:LEN_TRIM(tmp_def)),'=y' |
---|
| 422 | |
---|
| 423 | ELSE |
---|
| 424 | |
---|
| 425 | WRITE(18,'(3a)') tmp_key(1:LEN_TRIM(tmp_key)),'=', & |
---|
| 426 | & tmp_def(1:LEN_TRIM(tmp_def)) |
---|
| 427 | |
---|
| 428 | ENDIF |
---|
| 429 | ! |
---|
| 430 | ! Add some empty line to all files |
---|
| 431 | ! |
---|
| 432 | WRITE(16,'(1a)') ' ' |
---|
| 433 | WRITE(17,'(1a)') ' ' |
---|
| 434 | WRITE(17,'(1a)') ' ' |
---|
| 435 | ENDDO |
---|
| 436 | ! |
---|
| 437 | ! |
---|
| 438 | ! Close the IF if needed |
---|
| 439 | ! |
---|
| 440 | |
---|
| 441 | IF ( IF_pos(IFF) .GT. 0) THEN |
---|
| 442 | WRITE(16,'(1a)') 'fi' |
---|
| 443 | WRITE(16,'(1a)') ' ' |
---|
| 444 | ENDIF |
---|
| 445 | |
---|
| 446 | ! |
---|
| 447 | ENDDO |
---|
| 448 | ! |
---|
| 449 | WRITE(16,'(1a)') 'endmenu' |
---|
| 450 | WRITE(16,'(1a)') ' ' |
---|
| 451 | IF ( nbsource .GT. 0) THEN |
---|
| 452 | DO ih=1,nbsource |
---|
| 453 | tmp = source(ih) |
---|
| 454 | WRITE(16,'(1a)') ' ' |
---|
| 455 | WRITE(16,'(3a)') 'source ',tmp(1:LEN_TRIM(tmp)), & |
---|
| 456 | & '/Config.in' |
---|
| 457 | ENDDO |
---|
| 458 | ENDIF |
---|
| 459 | ! |
---|
| 460 | ! |
---|
| 461 | CLOSE(16) |
---|
| 462 | CLOSE(17) |
---|
| 463 | CLOSE(18) |
---|
| 464 | ! |
---|
| 465 | ! |
---|
| 466 | ! |
---|
| 467 | STOP |
---|
| 468 | |
---|
| 469 | END PROGRAM fparser |
---|
| 470 | ! |
---|
| 471 | ! |
---|
| 472 | !========================================================== |
---|
| 473 | ! |
---|
| 474 | ! |
---|
| 475 | SUBROUTINE READ_from_file(file, nbkeymax, nbelmax, configs, nbitems, itemlen) |
---|
| 476 | ! |
---|
| 477 | USE stringop |
---|
| 478 | ! |
---|
| 479 | IMPLICIT NONE |
---|
| 480 | ! |
---|
| 481 | ! |
---|
| 482 | ! This routine reads the file and adds the config info it finds to the configs array. |
---|
| 483 | ! Thus the nbitems is an imput variable as it can be increased as we go through the files. |
---|
| 484 | ! |
---|
| 485 | ! |
---|
| 486 | CHARACTER*(*) :: file |
---|
| 487 | INTEGER :: nbkeymax, nbelmax |
---|
| 488 | CHARACTER*120 :: configs(nbkeymax, nbelmax) |
---|
| 489 | INTEGER :: nbitems, itemlen(nbkeymax) |
---|
| 490 | ! |
---|
| 491 | INTEGER :: conf_pos, ip |
---|
| 492 | CHARACTER*250 line |
---|
| 493 | LOGICAL :: cont, conf_END |
---|
| 494 | ! |
---|
| 495 | cont = .TRUE. |
---|
| 496 | conf_END = .TRUE. |
---|
| 497 | ! |
---|
| 498 | OPEN (12, file=file) |
---|
| 499 | ! |
---|
| 500 | ! 1.0 Loop over all the lines of a given file to extract all the configuration line |
---|
| 501 | ! |
---|
| 502 | DO WHILE (cont) |
---|
| 503 | READ(12,'(a)',END=9999) line |
---|
| 504 | ! |
---|
| 505 | ! 1.0 A configuration line is detected by the line below. |
---|
| 506 | ! |
---|
| 507 | IF ( INDEX(line,'Config') .EQ. 1 .OR. INDEX(line,'!'//'Config') .GE. 1 ) THEN |
---|
| 508 | ! |
---|
| 509 | IF ( conf_END ) THEN |
---|
| 510 | nbitems = nbitems + 1 |
---|
| 511 | IF ( nbitems .GT. nbkeymax) THEN |
---|
| 512 | WRITE(*,*) 'read_from_file : The number of keys in the input array is too small for this file' |
---|
| 513 | STOP |
---|
| 514 | ENDIF |
---|
| 515 | itemlen(nbitems) = 0 |
---|
| 516 | conf_END = .FALSE. |
---|
| 517 | ENDIF |
---|
| 518 | ! |
---|
| 519 | itemlen(nbitems) = itemlen(nbitems) + 1 |
---|
| 520 | IF ( itemlen(nbitems) .GT. nbelmax ) THEN |
---|
| 521 | WRITE(*,*) 'read_from_file : The number of elements per key in the input array is too small' |
---|
| 522 | STOP |
---|
| 523 | ENDIF |
---|
| 524 | ! |
---|
| 525 | ! The detected line is shaved ! |
---|
| 526 | ! |
---|
| 527 | IF ( INDEX(line,'Config') .EQ. 1) THEN |
---|
| 528 | conf_pos = 7 |
---|
| 529 | ELSE |
---|
| 530 | conf_pos = INDEX(line,'!'//'Config') +7 |
---|
| 531 | ENDIF |
---|
| 532 | line = line(conf_pos:LEN_TRIM(line)) |
---|
| 533 | line = TRIM(ADJUSTL(line)) |
---|
| 534 | CALL cmpblank(line) |
---|
| 535 | ! |
---|
| 536 | configs(nbitems,itemlen(nbitems)) = line |
---|
| 537 | ! |
---|
| 538 | ELSE |
---|
| 539 | ! |
---|
| 540 | ! Look for the end of a configuration structure. |
---|
| 541 | ! It is determined by a call to the getin subroutine |
---|
| 542 | ! |
---|
| 543 | CALL strlowercase(line) |
---|
| 544 | CALL cmpblank(line) |
---|
| 545 | ip = INDEX(line,' (') |
---|
| 546 | DO WHILE (ip .GT. 0) |
---|
| 547 | line = line(1:ip-1)//line(ip+1:LEN_TRIM(line)) |
---|
| 548 | ip = INDEX(line,' (') |
---|
| 549 | ENDDO |
---|
| 550 | IF ( INDEX(line, 'call getin(') .GT. 0 .OR. INDEX(line, 'call setvar(') .GT. 0) THEN |
---|
| 551 | conf_END = .TRUE. |
---|
| 552 | ENDIF |
---|
| 553 | ! |
---|
| 554 | ENDIF |
---|
| 555 | ! |
---|
| 556 | cont = .TRUE. |
---|
| 557 | GOTO 8888 |
---|
| 558 | 9999 cont = .FALSE. |
---|
| 559 | 8888 CONTINUE |
---|
| 560 | |
---|
| 561 | ENDDO |
---|
| 562 | ! |
---|
| 563 | CLOSE(12) |
---|
| 564 | ! |
---|
| 565 | END SUBROUTINE READ_from_file |
---|
| 566 | ! |
---|
| 567 | !========================================================== |
---|
| 568 | ! |
---|
| 569 | ! |
---|
| 570 | SUBROUTINE analyse_configs(nbkmax, nb_key, nbelmax, keylen, configs, key_pos, help_pos, def_pos, des_pos, IF_pos, TYPE_op) |
---|
| 571 | ! |
---|
| 572 | USE stringop |
---|
| 573 | ! |
---|
| 574 | IMPLICIT NONE |
---|
| 575 | ! |
---|
| 576 | ! |
---|
| 577 | ! This subroutine will localize the KEYWORDS in the configs array |
---|
| 578 | ! and extract all their arguments. For the moment 5 arguments are recognized : |
---|
| 579 | ! KEY : The keyword by which the all is identified |
---|
| 580 | ! HELP : This identifies the help text |
---|
| 581 | ! DEF : The default value of for this KEYWORD |
---|
| 582 | ! DESC : A short description, not more than one line |
---|
| 583 | ! IF : Specifies the other Keyword it depend on. This is a nice features for the menus as it can hide |
---|
| 584 | ! things we do not need |
---|
| 585 | ! |
---|
| 586 | ! The DEF and HELP keywords can be multi line |
---|
| 587 | ! |
---|
| 588 | INTEGER :: nbkmax, nb_key, nbelmax |
---|
| 589 | INTEGER :: keylen(nbkmax) |
---|
| 590 | INTEGER :: key_pos(nbkmax), help_pos(nbkmax,2), def_pos(nbkmax,2), des_pos(nbkmax), IF_pos(nbkmax) |
---|
| 591 | CHARACTER*120 :: configs(nbkmax,nbelmax) |
---|
| 592 | CHARACTER*6 :: TYPE_op(nbkmax) |
---|
| 593 | ! |
---|
| 594 | ! This is the number of arguments we need to find an end for and the total number of arguments we can have. |
---|
| 595 | ! Thus these parameters needs to be updated when the list of arguments to the routine is changed |
---|
| 596 | ! |
---|
| 597 | INTEGER, PARAMETER :: toendlen=2, indexlen=5 |
---|
| 598 | ! |
---|
| 599 | INTEGER :: toend(toendlen), foundend(toendlen), kindex(indexlen) |
---|
| 600 | INTEGER :: ik, il, ieq |
---|
| 601 | CHARACTER*120 :: tmp_str, tmp_str2 |
---|
| 602 | ! |
---|
| 603 | ! |
---|
| 604 | key_pos(1:nb_key)=-1 |
---|
| 605 | help_pos(1:nb_key,1:2)=-1 |
---|
| 606 | def_pos(1:nb_key,1:2)=-1 |
---|
| 607 | des_pos(1:nb_key)=-1 |
---|
| 608 | IF_pos(1:nb_key)=-1 |
---|
| 609 | TYPE_op(1:nb_key)='hex' |
---|
| 610 | ! |
---|
| 611 | DO ik=1,nb_key |
---|
| 612 | ! |
---|
| 613 | ! |
---|
| 614 | DO il=1,keylen(ik) |
---|
| 615 | ! |
---|
| 616 | ieq = INDEX(configs(ik,il),'=') |
---|
| 617 | tmp_str = configs(ik,il) |
---|
| 618 | tmp_str = tmp_str(1:ieq) |
---|
| 619 | CALL struppercase(tmp_str) |
---|
| 620 | ! |
---|
| 621 | ! Decide if this is a reserved name and where it fits |
---|
| 622 | ! |
---|
| 623 | ! At the same time we clean up the configs array |
---|
| 624 | ! |
---|
| 625 | IF ( INDEX(tmp_str,'KEY') .GT. 0) THEN |
---|
| 626 | IF ( key_pos(ik) .GT. 0) THEN |
---|
| 627 | WRITE(*,*) 'analyse_config : Already have a KEYWORD, check that you have a call to getin' |
---|
| 628 | WRITE(*,*) 'analyse_config : ', configs(ik,il) |
---|
| 629 | STOP |
---|
| 630 | ENDIF |
---|
| 631 | key_pos(ik) = il |
---|
| 632 | tmp_str2 = configs(ik,il) |
---|
| 633 | tmp_str2 = tmp_str2(ieq+1:LEN_TRIM(tmp_str2)) |
---|
| 634 | configs(ik,il) = TRIM(ADJUSTL(tmp_str2)) |
---|
| 635 | ! |
---|
| 636 | ! Here we have to check that we are not in an 'choice' case |
---|
| 637 | ! |
---|
| 638 | IF ( INDEX(tmp_str2,'||') .GT. 0) THEN |
---|
| 639 | TYPE_op(ik) = 'choice' |
---|
| 640 | ENDIF |
---|
| 641 | ! |
---|
| 642 | ENDIF |
---|
| 643 | ! |
---|
| 644 | IF ( INDEX(tmp_str,'DEF') .GT. 0) THEN |
---|
| 645 | IF ( def_pos(ik,1) .GT. 0) THEN |
---|
| 646 | WRITE(*,*) 'analyse_config : Already have a DEF, check that you have a call to getin' |
---|
| 647 | WRITE(*,*) 'analyse_config : ', configs(ik,il) |
---|
| 648 | STOP |
---|
| 649 | ENDIF |
---|
| 650 | def_pos(ik,1) = il |
---|
| 651 | tmp_str2 = configs(ik,il) |
---|
| 652 | tmp_str2 = tmp_str2(ieq+1:LEN_TRIM(tmp_str2)) |
---|
| 653 | tmp_str2 = TRIM(ADJUSTL(tmp_str2)) |
---|
| 654 | configs(ik,il) = tmp_str2 |
---|
| 655 | ! |
---|
| 656 | ! Here we can check if we have a boolean operation |
---|
| 657 | ! We also wish to standardise the value of booleans |
---|
| 658 | ! |
---|
| 659 | CALL struppercase(tmp_str2) |
---|
| 660 | IF (INDEX(tmp_str2,'Y') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 1 .OR.& |
---|
| 661 | & INDEX(tmp_str2,'T') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 1 .OR.& |
---|
| 662 | & INDEX(tmp_str2,'YES') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 3 .OR.& |
---|
| 663 | & INDEX(tmp_str2,'TRUE') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 4 .OR.& |
---|
| 664 | & INDEX(tmp_str2,'.TRUE.') .EQ. 1) THEN |
---|
| 665 | configs(ik,il) = 'y' |
---|
| 666 | TYPE_op(ik) = 'bool' |
---|
| 667 | ENDIF |
---|
| 668 | ! |
---|
| 669 | IF (INDEX(tmp_str2,'N') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 1 .OR.& |
---|
| 670 | & INDEX(tmp_str2,'F') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 1 .OR.& |
---|
| 671 | & INDEX(tmp_str2,'NO') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 2 .OR.& |
---|
| 672 | & INDEX(tmp_str2,'FALSE') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 5 .OR.& |
---|
| 673 | & INDEX(tmp_str2,'.FALSE.') .EQ. 1) THEN |
---|
| 674 | configs(ik,il) = 'n' |
---|
| 675 | TYPE_op(ik) = 'bool' |
---|
| 676 | ENDIF |
---|
| 677 | ! |
---|
| 678 | ! Here we check if we have a default behavior and put a standard name |
---|
| 679 | ! |
---|
| 680 | IF (INDEX(tmp_str2,'DEF') .EQ. 1 .OR. INDEX(tmp_str2,'NONE') .EQ. 1) THEN |
---|
| 681 | configs(ik,il) = 'default' |
---|
| 682 | ENDIF |
---|
| 683 | ! |
---|
| 684 | ENDIF |
---|
| 685 | ! |
---|
| 686 | IF ( INDEX(tmp_str,'DESC') .GT. 0) THEN |
---|
| 687 | IF ( des_pos(ik) .GT. 0) THEN |
---|
| 688 | WRITE(*,*) 'analyse_config : Already have a DESC, check that you have a call to getin' |
---|
| 689 | WRITE(*,*) 'analyse_config : ', configs(ik,il) |
---|
| 690 | STOP |
---|
| 691 | ENDIF |
---|
| 692 | des_pos(ik) = il |
---|
| 693 | tmp_str2 = configs(ik,il) |
---|
| 694 | tmp_str2 = tmp_str2(ieq+1:LEN_TRIM(tmp_str2)) |
---|
| 695 | configs(ik,il) = TRIM(ADJUSTL(tmp_str2)) |
---|
| 696 | ENDIF |
---|
| 697 | ! |
---|
| 698 | IF ( INDEX(tmp_str,'IF') .GT. 0) THEN |
---|
| 699 | IF ( IF_pos(ik) .GT. 0) THEN |
---|
| 700 | WRITE(*,*) 'analyse_config : Already have a IF, check that you have a call to getin' |
---|
| 701 | WRITE(*,*) 'analyse_config : ', configs(ik,il) |
---|
| 702 | STOP |
---|
| 703 | ENDIF |
---|
| 704 | IF_pos(ik) = il |
---|
| 705 | tmp_str2 = configs(ik,il) |
---|
| 706 | tmp_str2 = tmp_str2(ieq+1:LEN_TRIM(tmp_str2)) |
---|
| 707 | configs(ik,il) = TRIM(ADJUSTL(tmp_str2)) |
---|
| 708 | ENDIF |
---|
| 709 | ! |
---|
| 710 | IF ( INDEX(tmp_str,'HELP') .GT. 0) THEN |
---|
| 711 | help_pos(ik,1) = il |
---|
| 712 | tmp_str2 = configs(ik,il) |
---|
| 713 | tmp_str2 = tmp_str2(ieq+1:LEN_TRIM(tmp_str2)) |
---|
| 714 | configs(ik,il) = TRIM(ADJUSTL(tmp_str2)) |
---|
| 715 | ENDIF |
---|
| 716 | ! |
---|
| 717 | ENDDO |
---|
| 718 | ! |
---|
| 719 | ! Check if we not missing some important informations as for instance |
---|
| 720 | ! |
---|
| 721 | ! THE KEYWORD |
---|
| 722 | ! |
---|
| 723 | IF ( key_pos(ik) .LT. 1) THEN |
---|
| 724 | WRITE(*,*) 'analyse_configs : Could not find a keyword in the following entry :' |
---|
| 725 | DO il=1,keylen(ik) |
---|
| 726 | WRITE(*,'(a70)') configs(ik,il) |
---|
| 727 | ENDDO |
---|
| 728 | STOP |
---|
| 729 | ENDIF |
---|
| 730 | ! |
---|
| 731 | ! THE DEFAULT VALUE |
---|
| 732 | ! |
---|
| 733 | IF ( def_pos(ik,1) .LT. 1) THEN |
---|
| 734 | WRITE(*,*) 'analyse_configs : Could not find a default value in the following entry :' |
---|
| 735 | DO il=1,keylen(ik) |
---|
| 736 | WRITE(*,'(a70)') configs(ik,il) |
---|
| 737 | ENDDO |
---|
| 738 | STOP |
---|
| 739 | ENDIF |
---|
| 740 | ! |
---|
| 741 | ! Get the end of all the multi line arguments |
---|
| 742 | ! |
---|
| 743 | toend(1) = MAX(def_pos(ik,1),1) |
---|
| 744 | toend(2) = MAX(help_pos(ik,1),1) |
---|
| 745 | foundend(:) = keylen(ik) |
---|
| 746 | kindex(1) = MAX(key_pos(ik),1) |
---|
| 747 | kindex(2) = MAX(des_pos(ik),1) |
---|
| 748 | kindex(3) = MAX(def_pos(ik,1),1) |
---|
| 749 | kindex(4) = MAX(IF_pos(ik),1) |
---|
| 750 | kindex(5) = MAX(help_pos(ik,1),1) |
---|
| 751 | CALL find_ends(toendlen, toend, indexlen, kindex, foundend) |
---|
| 752 | def_pos(ik,2) = foundend(1) |
---|
| 753 | help_pos(ik,2) = foundend(2) |
---|
| 754 | ! |
---|
| 755 | ENDDO |
---|
| 756 | ! |
---|
| 757 | END SUBROUTINE analyse_configs |
---|
| 758 | ! |
---|
| 759 | SUBROUTINE find_ends(toendlen, toend, indexlen, kindex, foundend) |
---|
| 760 | ! |
---|
| 761 | IMPLICIT NONE |
---|
| 762 | ! |
---|
| 763 | ! |
---|
| 764 | ! We find the end of the text for all the elements in the key which are multi line |
---|
| 765 | ! This subroutine aims at providing a flexible way to determine this so that other |
---|
| 766 | ! elements in the Keyword can be multi line. For the moment it is only the Help and Ded |
---|
| 767 | ! which are allowed to be multi line. |
---|
| 768 | ! |
---|
| 769 | ! Foundend need to be initialized to the maximum value of the elements |
---|
| 770 | ! |
---|
| 771 | ! |
---|
| 772 | INTEGER :: toendlen, toend(toendlen), indexlen, kindex(indexlen), foundend(toendlen) |
---|
| 773 | ! |
---|
| 774 | INTEGER :: whmin(1), ie, ii |
---|
| 775 | ! |
---|
| 776 | DO ie=1,toendlen |
---|
| 777 | ! |
---|
| 778 | whmin = MINLOC(toend(1:toendlen)) |
---|
| 779 | ! |
---|
| 780 | DO ii=1,indexlen |
---|
| 781 | IF ( kindex(ii) .GT. toend(whmin(1)) .AND. foundend(whmin(1)) .GE. kindex(ii)) THEN |
---|
| 782 | foundend(whmin(1)) = kindex(ii)-1 |
---|
| 783 | toend(whmin(1)) = 100000 |
---|
| 784 | ENDIF |
---|
| 785 | ENDDO |
---|
| 786 | ! |
---|
| 787 | ENDDO |
---|
| 788 | ! |
---|
| 789 | END SUBROUTINE find_ends |
---|