1! autopilot.f90 2!******************************************************************************** 3! autopilot.f90 Copyright (c) 2005 Targacept, Inc. 4!******************************************************************************** 5! The Autopilot Feature suite is a user level enhancement that enables the 6! following features: 7! automatic restart of a job; 8! preconfiguration of job parameters; 9! on-the-fly changes to job parameters; 10! and pausing of a running job. 11! 12! For more information, see README.AUTOPILOT in document directory. 13! 14! This program is free software; you can redistribute it and/or modify it under 15! the terms of the GNU General Public License as published by the Free Software 16! Foundation; either version 2 of the License, or (at your option) any later version. 17! This program is distributed in the hope that it will be useful, but WITHOUT ANY 18! WARRANTY; without even the implied warranty of MERCHANTABILITY FOR A PARTICULAR 19! PURPOSE. See the GNU General Public License at www.gnu.or/copyleft/gpl.txt for 20! more details. 21! 22! THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. 23! EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES 24! PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED, 25! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 26! FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND THE 27! PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, 28! YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 29! 30! IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING, 31! WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE 32! THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY 33! GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR 34! INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA 35! BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A 36! FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER 37! OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 38! 39! You should have received a copy of the GNU General Public License along with 40! this program; if not, write to the 41! Free Software Foundation, Inc., 42! 51 Franklin Street, 43! Fifth Floor, 44! Boston, MA 02110-1301, USA. 45! 46! Targacept's address is 47! 200 East First Street, Suite 300 48! Winston-Salem, North Carolina USA 27101-4165 49! Attn: Molecular Design. 50! Email: atp@targacept.com 51! 52! This work was supported by the Advanced Technology Program of the 53! National Institute of Standards and Technology (NIST), Award No. 70NANB3H3065 54! 55!******************************************************************************** 56 57 58MODULE autopilot 59 !--------------------------------------------------------------------------- 60 ! 61 ! This module handles the Autopilot Feature Suite 62 ! Written by Lee Atkinson, with help from the ATP team at Targacept, Inc 63 ! Created June 2005 64 ! Modified by Yonas Abraham, Sept 2006 65 ! 66 ! The address for Targacept, Inc. is: 67 ! 200 East First Street, Suite 68 ! 300, Winston-Salem, North Carolina 27101; 69 ! Attn: Molecular Design. 70 ! 71 ! See README.AUTOPILOT in the Doc directory for more information. 72 !--------------------------------------------------------------------------- 73 74 USE kinds 75 USE parser, ONLY : read_line 76 77 IMPLICIT NONE 78 SAVE 79 80 INTEGER, parameter :: MAX_INT = huge(1) 81 INTEGER, parameter :: max_event_step = 32 !right now there can be upto 32 Autopilot Events 82 INTEGER, parameter :: n_auto_vars = 10 !right now there are only 10 Autopilot Variables 83 84 INTEGER :: n_events 85 INTEGER :: event_index = 0 86 INTEGER :: max_rules = 320 !(max_event_step * n_auto_vars) 87 INTEGER :: n_rules 88 INTEGER :: event_step(max_event_step) 89 INTEGER :: current_nfi 90 LOGICAL :: pilot_p = .FALSE. ! pilot property 91 LOGICAL :: restart_p = .FALSE. ! restart property 92 LOGICAL :: pause_p = .FALSE. ! pause property 93 INTEGER :: pilot_unit = 42 ! perhaps move this to io_files 94 CHARACTER(LEN=256) :: pilot_type 95 96 ! AUTOPILOT VARIABLES 97 ! These are the variable tables which change the actual variable 98 ! dynamically during the course of a simulation. There are many 99 ! parameters which govern a simulation, yet only these are allowed 100 ! to be changed using the event rule mechanism. 101 ! Each of these tables are typed according to their variable 102 ! and begin with event_ 103 104 ! &CONTROL 105 INTEGER :: rule_isave(max_event_step) 106 INTEGER :: rule_iprint(max_event_step) 107 LOGICAL :: rule_tprint(max_event_step) 108 REAL(DP) :: rule_dt(max_event_step) 109 ! &SYSTEM 110 111 ! &ELECTRONS 112 REAL(DP) :: rule_emass(max_event_step) 113 CHARACTER(LEN=80) :: rule_electron_dynamics(max_event_step) 114 REAL(DP) :: rule_electron_damping(max_event_step) 115 CHARACTER(LEN=80) :: rule_electron_orthogonalization(max_event_step) 116 117 118 ! &IONS 119 CHARACTER(LEN=80) :: rule_ion_dynamics(max_event_step) 120 REAL(DP) :: rule_ion_damping(max_event_step) 121 CHARACTER(LEN=80) :: rule_ion_temperature(max_event_step) 122 REAL(DP) :: rule_tempw(max_event_step) 123 INTEGER :: rule_nhpcl(max_event_step) 124 REAL(DP) :: rule_fnosep(max_event_step) 125 ! &CELL 126 127 ! &PHONON 128 129 130 ! Each rule also needs to be correlated (flagged) against the event time table 131 ! This is used to flag the a given variable is to be changed on an 132 ! event. Initially all set to false, a rule against an event makes it true 133 ! Each of these flags are LOGICALs and begin with event_ 134 ! &CONTROL 135 LOGICAL :: event_isave(max_event_step) 136 LOGICAL :: event_iprint(max_event_step) 137 LOGICAL :: event_tprint(max_event_step) 138 LOGICAL :: event_dt(max_event_step) 139 ! &SYSTEM 140 141 ! &ELECTRONS 142 LOGICAL :: event_emass(max_event_step) 143 LOGICAL :: event_electron_dynamics(max_event_step) 144 LOGICAL :: event_electron_damping(max_event_step) 145 LOGICAL :: event_electron_orthogonalization(max_event_step) 146 147 ! &IONS 148 LOGICAL :: event_ion_dynamics(max_event_step) 149 LOGICAL :: event_ion_damping(max_event_step) 150 LOGICAL :: event_ion_temperature(max_event_step) 151 LOGICAL :: event_tempw(max_event_step) 152 LOGICAL :: event_nhpcl(max_event_step) 153 LOGICAL :: event_fnosep(max_event_step) 154 ! &CELL 155 156 ! &PHONON 157 158 159 PRIVATE 160 PUBLIC :: auto_check, init_autopilot, card_autopilot, add_rule, & 161 & assign_rule, restart_p, max_event_step, event_index, event_step, rule_isave, & 162 & rule_iprint, & 163 & rule_tprint, & 164 & rule_dt, rule_emass, rule_electron_dynamics, rule_electron_damping, & 165 & rule_ion_dynamics, rule_ion_damping, rule_ion_temperature, rule_tempw, & 166 & rule_electron_orthogonalization, & 167 & event_isave, event_iprint, & 168 & event_tprint, & 169 & event_dt, event_emass, & 170 & event_electron_dynamics, event_electron_damping, event_ion_dynamics, & 171 & current_nfi, pilot_p, pilot_unit, pause_p,auto_error, parse_mailbox, & 172 & event_ion_damping, event_ion_temperature, event_tempw, & 173 & event_electron_orthogonalization, & 174 & event_nhpcl, event_fnosep, rule_nhpcl, rule_fnosep 175 176 177CONTAINS 178 179 !---------------------------------------------------------------------------- 180 SUBROUTINE auto_error( calling_routine, message) 181 !---------------------------------------------------------------------------- 182 ! This routine calls errore based upon the pilot property flag. 183 ! If the flag is TRUE, the simulation will not stop, 184 ! but the pause property flag is set to TRUE, 185 ! causing pilot to force a state of sleep, 186 ! until the user can mail proper commands. 187 ! Otherwise, its assumed that dynamics have not started 188 ! and this call is an indirect result of read_cards. 189 ! Thus the simulation will stop. 190 ! Either way errore will always issues a warning message. 191 192 IMPLICIT NONE 193 ! 194 CHARACTER(LEN=*), INTENT(IN) :: calling_routine, message 195 ! the name of the calling calling_routinee 196 ! the output message 197 INTEGER :: ierr 198 ! the error flag 199 200 IF (pilot_p) THEN 201 ! if ierr < 0 errore writes the message but does not stop 202 ierr = -1 203 pause_p = .TRUE. 204 !call mp_bcast(pause_p, ionode_id, world_comm) 205 ELSE 206 ! if ierr > 0 it stops 207 ierr = 1 208 ENDIF 209 210 CALL errore( calling_routine, message, ierr ) 211 212 END SUBROUTINE auto_error 213 214 215 !----------------------------------------------------------------------- 216 ! AUTO (restart) MODE 217 ! 218 ! Checks if restart files are present, just like what readfile_cp does, 219 ! which calls cp_readfile which create a path to restart.xml. 220 ! This could be checked with inquire, as in check_restartfile. 221 ! If restart_mode=auto, and restart.xml is present, 222 ! then restart_mode="restart", else its "from_scratch". 223 ! Set other associated vars, appropriately. 224 ! 225 ! Put this in setcontrol_flags on the select statement 226 !----------------------------------------------------------------------- 227 LOGICAL FUNCTION auto_check (ndr, outdir) 228 USE io_global, ONLY: ionode, ionode_id 229 USE mp, ONLY : mp_bcast 230 USE mp_world, ONLY : world_comm 231 IMPLICIT NONE 232 INTEGER, INTENT(IN) :: ndr ! I/O unit number 233 CHARACTER(LEN=*), INTENT(IN) :: outdir 234 CHARACTER(LEN=256) :: dirname, filename 235 CHARACTER (LEN=6), EXTERNAL :: int_to_char 236 LOGICAL :: restart_p = .FALSE. 237 INTEGER :: strlen 238 ! right now cp_readfile is called with outdir = ' ' 239 ! so, in keeping with the current design, 240 ! the responsibility of setting 241 ! ndr and outdir is the calling program 242 243 244 IF (ionode) THEN 245 dirname = 'RESTART' // int_to_char( ndr ) 246 IF ( LEN( outdir ) > 1 ) THEN 247 strlen = index(outdir,' ') - 1 248 dirname = outdir(1:strlen) // '/' // dirname 249 END IF 250 251 filename = TRIM( dirname ) // '/' // 'restart.xml' 252 INQUIRE( FILE = TRIM( filename ), EXIST = restart_p ) 253 254 auto_check = restart_p 255 END IF 256 CALL mp_bcast(auto_check, ionode_id, world_comm) 257 258 return 259 260 END FUNCTION auto_check 261 262 263 !----------------------------------------------------------------------- 264 ! INITIALIZE AUTOPILOT 265 ! 266 ! Must be done, even if not in use. 267 ! Add this as a call in read_cards.f90 sub: card_default_values 268 !----------------------------------------------------------------------- 269 SUBROUTINE init_autopilot 270 IMPLICIT NONE 271 integer :: event 272 273 pause_p = .FALSE. 274 275 ! Initialize all events to an iteration that should never occur 276 DO event=1,max_event_step 277 event_step(event) = MAX_INT 278 ENDDO 279 280 n_events = 0 281 n_rules = 0 282 event_index = 1 283 284 ! Initialize here 285 ! &CONTROL 286 event_isave(:) = .false. 287 event_iprint(:) = .false. 288 event_tprint(:) = .false. 289 event_dt(:) = .false. 290 ! &SYSTEM 291 ! &ELECTRONS 292 event_emass(:) = .false. 293 event_electron_dynamics(:) = .false. 294 event_electron_damping(:) = .false. 295 event_electron_orthogonalization(:) = .false. 296 297 298 ! &IONS 299 event_ion_dynamics(:) = .false. 300 event_ion_damping(:) = .false. 301 event_ion_temperature(:) = .false. 302 event_tempw(:) = .false. 303 ! &CELL 304 ! &PHONON 305 306 rule_isave(:) = 0 307 rule_iprint(:) = 0 308 rule_tprint(:) = .FALSE. 309 rule_dt(:) = 0.0_DP 310 rule_emass(:) = 0.0_DP 311 rule_electron_dynamics(:) = 'NONE' 312 rule_electron_damping(:) = 0.0_DP 313 rule_ion_dynamics(:) = 'NONE' 314 rule_ion_damping(:) = 0.0_DP 315 rule_ion_temperature(:) = 'NOT_CONTROLLED' 316 rule_tempw(:) = 0.01_DP 317 318 END SUBROUTINE init_autopilot 319 320 321 322 !----------------------------------------------------------------------- 323 ! subroutine CARD_AUTOPILOT 324 ! 325 ! called in READ_CARDS and in PARSE_MAILBOX 326 !----------------------------------------------------------------------- 327 SUBROUTINE card_autopilot( input_line ) 328 USE io_global, ONLY: ionode 329 IMPLICIT NONE 330 INTEGER :: i, j, linelen 331 CHARACTER(LEN=256) :: input_line 332 LOGICAL :: process_this_line = .FALSE. 333 LOGICAL :: endrules = .FALSE. 334 LOGICAL :: tend = .FALSE. 335 LOGICAL, SAVE :: tread = .FALSE. 336 LOGICAL, EXTERNAL :: matches 337 CHARACTER(LEN=1), EXTERNAL :: capital 338 339 !ASU: copied this here since it seems not to be executed during each 340 ! call of the routine. Needed for multiple rules in same block 341 process_this_line = .FALSE. 342 endrules = .FALSE. 343 tend = .FALSE. 344 tread = .FALSE. 345 346 ! This is so we do not read a autopilot card twice from the input file 347 IF (( .NOT. pilot_p ) .and. tread ) THEN 348 CALL errore( ' card_autopilot ', ' two occurrences', 2 ) 349 END IF 350 351 ! If this routined has been called from parse_mailbox 352 ! the pilot_type should be set 353 IF ( pilot_p ) THEN 354 ! IF its MANUAL then process this line first! 355 ! other skip this line and get the next 356 IF (TRIM(pilot_type) .eq. 'MANUAL') THEN 357 process_this_line = .TRUE. 358 ELSE IF (TRIM(pilot_type) .eq. 'PILOT') THEN 359 process_this_line = .FALSE. 360 ELSE IF (TRIM(pilot_type) .eq. 'AUTO') THEN 361 process_this_line = .FALSE. 362 ELSE 363 IF( ionode ) WRITE(*,*) 'AUTOPILOT: UNRECOGNIZED PILOT TYPE!', TRIM(pilot_type), '====' 364 GO TO 10 365 END IF 366 ELSE 367 ! this routine is called from read_cards 368 pilot_type = 'AUTO' 369 process_this_line = .FALSE. 370 END IF 371 372 j=0 373 ! must use a local (j) since n_rules may not get updated correctly 374 DO WHILE ((.NOT. endrules) .and. j<=max_rules) 375 j=j+1 376 377 IF (j > max_rules) THEN 378 CALL auto_error( ' AutoPilot ','Maximum Number of Dynamic Rules May Have Been Execced!') 379 go to 10 380 END IF 381 382 ! Assume that pilot_p is an indicator and that 383 ! this call to card_autopilot is from parse_mailbox 384 ! and not from read_cards 385 IF(pilot_p) THEN 386 IF ( .NOT. process_this_line ) THEN 387 ! get the next one 388 CALL read_line( input_line, end_of_file = tend) 389 END IF 390 ELSE 391 ! from read_cards 392 CALL read_line( input_line, end_of_file = tend) 393 END IF 394 395 linelen = LEN_TRIM( input_line ) 396 397 DO i = 1, linelen 398 input_line( i : i ) = capital( input_line( i : i ) ) 399 END DO 400 401 ! If ENDRULES isnt found, add_rule will fail 402 ! and we run out of line anyway 403 404 IF ( tend .or. matches( 'ENDRULES', input_line ) ) GO TO 10 405 406 ! Assume this is a rule 407 CALL ADD_RULE(input_line) 408 ! now, do not process this line anymore 409 ! make sure we get the next one 410 process_this_line = .FALSE. 411 412 END DO 413 414 IF( ionode ) WRITE(*,*) 'AUTOPILOT SET' 415 41610 CONTINUE 417 418 END SUBROUTINE card_autopilot 419 420 421 422 423 424 !----------------------------------------------------------------------- 425 ! ADD RULE 426 !----------------------------------------------------------------------- 427 SUBROUTINE add_rule( input_line ) 428 USE io_global, ONLY: ionode 429 IMPLICIT NONE 430 integer :: i, linelen 431 integer :: eq1_pos, eq2_pos, plus_pos, colon_pos 432 CHARACTER(LEN=256) :: input_line 433 CHARACTER(LEN=32) :: var_label 434 CHARACTER(LEN=32) :: value_str 435 INTEGER :: on_step, now_step, plus_step 436 integer :: ios 437 integer :: event 438 439 LOGICAL, EXTERNAL :: matches 440 LOGICAL :: new_event 441 442 443 ! this is a temporary local variable 444 event = n_events 445 446 ! important for parsing 447 i=0 448 eq1_pos = 0 449 eq2_pos = 0 450 plus_pos = 0 451 colon_pos = 0 452 453 linelen=LEN_TRIM( input_line ) 454 455 456 ! Attempt to get PLUS SYMBOL 457 i = 1 458 do while( (plus_pos .eq. 0) .and. (i <= linelen) ) 459 i = i + 1 460 if(input_line( i : i ) .eq. '+') then 461 plus_pos = i 462 endif 463 end do 464 465 ! Attempt to get a colon 466 i = 1 467 do while( (colon_pos .eq. 0) .and. (i <= linelen) ) 468 i = i + 1 469 if(input_line( i : i ) .eq. ':') then 470 colon_pos = i 471 endif 472 end do 473 474 ! Attempt to get first equals 475 i = 1 476 do while( (eq1_pos .eq. 0) .and. (i <= linelen) ) 477 i = i + 1 478 if(input_line( i : i ) .eq. '=') then 479 eq1_pos = i 480 endif 481 end do 482 483 484 ! Attempt to get second equals 485 if ((eq1_pos .ne. 0) .and. (eq1_pos < colon_pos)) then 486 i = colon_pos + 1 487 do while( (eq2_pos .eq. 0) .and. (i <= linelen) ) 488 i = i + 1 489 if(input_line( i : i ) .eq. '=') then 490 eq2_pos = i 491 endif 492 end do 493 endif 494 495 ! Complain if there is a bad parse 496 if (colon_pos .eq. 0) then 497 call auto_error( ' AutoPilot ','Missing colon separator') 498 go to 20 499 endif 500 501 if (eq1_pos .eq. 0) then 502 call auto_error( ' AutoPilot ','Missing equals sign') 503 go to 20 504 endif 505 506 if ((plus_pos > 0) .and. (eq1_pos < colon_pos)) then 507 call auto_error( ' AutoPilot ','equals and plus found prior to colon') 508 go to 20 509 endif 510 511 512 !================================================================================ 513 ! Detect events 514 IF ( (pilot_type .eq. 'MANUAL') .or. (pilot_type .eq. 'PILOT') ) THEN 515 !------------------------------------------- 516 !Do the equivalent of the following: 517 !READ(input_line, *) now_label, plus_label1, plus_step, colon_label, var_label, eq_label2, value_str 518 !Format: 519 ! [NOW [+ plus_step] :] var_label = value_str 520 !------------------------------------------- 521 522 ! if there is a NOW, get it and try to get plus and plus_step 523 524 IF ( matches( 'NOW', input_line ) ) THEN 525 ! Attempt to get PLUS_STEP 526 plus_step = 0 527 ! if all is non-trivial, read a PLUS_STEP 528 if ((plus_pos > 0) .and. (colon_pos > plus_pos)) then 529 ! assume a number lies between 530 read(input_line(plus_pos+1:colon_pos-1),*,iostat=ios) plus_step 531 if(ios .ne. 0) then 532 CALL auto_error( ' AutoPilot ','Value Type Mismatch on NOW line!') 533 go to 20 534 end if 535 end if 536 ! set NOW event 537 now_step = current_nfi + plus_step 538 ELSE 539 ! set NOW event 540 now_step = current_nfi 541 END IF 542 543 544 !================================================================================ 545 ! set event 546 ! 547 ! Heres where it get interesting 548 ! We may have a new event , or not! :) 549 550 IF ((event-1) .gt. 0) THEN 551 IF ( now_step .lt. event_step(event-1)) THEN 552 IF( ionode ) write(*,*) ' AutoPilot: current input_line', input_line 553 CALL auto_error( ' AutoPilot ','Dynamic Rule Event Out of Order!') 554 go to 20 555 ENDIF 556 ENDIF 557 558 IF (event .eq. 0) THEN 559 new_event = .true. 560 ELSEIF ( now_step .gt. event_step(event)) THEN 561 new_event = .true. 562 ELSE 563 new_event = .false. 564 ENDIF 565 566 IF ( new_event ) THEN 567 ! new event 568 event = event + 1 569 570 IF (event > max_event_step) THEN 571 IF( ionode ) write(*,*) ' AutoPilot: current input_line', input_line 572 CALL auto_error( ' AutoPilot ','Maximum Number of Dynamic Rule Event Exceeded!') 573 go to 20 574 ENDIF 575 576 event_step(event) = now_step 577 n_events = event 578 ENDIF 579 580 581 ELSE IF ( matches( 'ON_STEP', input_line ) ) THEN 582 ! Assuming pilot_type is AUTO 583 ! if it isnt and ON_STEP these rules wont take anyway 584 585 !------------------------------------------- 586 !Do the equivalent of the following: 587 !READ(input_line, *) on_step_label, eq_label1, on_step, colon_label, var_label, eq_label2, value_str 588 !Format: 589 ! ON_STEP = on_step : var_label = value_str 590 !------------------------------------------- 591 592 IF( ionode ) write(*,*) 'ADD_RULE: POWER STEERING' 593 594 ! Attempt to get ON_STEP 595 on_step = MAX_INT 596 ! if all is non-trivial, read a PLUS_STEP 597 if ((eq1_pos > 0) .and. (colon_pos > eq1_pos)) then 598 ! assume a number lies between 599 read(input_line(eq1_pos+1:colon_pos-1),*,iostat=ios) on_step 600 if(ios .ne. 0) then 601 CALL auto_error( ' AutoPilot ','Value Type Mismatch on ON_STEP line!') 602 go to 20 603 end if 604 end if 605 606 607 608 !================================================================================ 609 ! set event 610 ! 611 ! Heres where it get interesting 612 ! We may have a new event , or not! :) 613 614 615 IF ( ((event-1) .gt. 0)) THEN 616 IF ( on_step .lt. event_step(event-1)) THEN 617 IF( ionode ) write(*,*) ' AutoPilot: current input_line', input_line 618 CALL auto_error( ' AutoPilot ','Dynamic Rule Event Out of Order!') 619 go to 20 620 ENDIF 621 ENDIF 622 623 624 IF (event .eq. 0) THEN 625 new_event = .true. 626 ELSEIF (on_step .gt. event_step(event)) THEN 627 new_event = .true. 628 ELSE 629 new_event = .false. 630 ENDIF 631 632 IF (new_event) THEN 633 ! new event 634 event = event + 1 635 IF (event > max_event_step) THEN 636 IF( ionode ) write(*,*) ' AutoPilot: current input_line', input_line 637 CALL auto_error( ' AutoPilot ','Maximum Number of Dynamic Rule Event Exceeded!') 638 go to 20 639 ENDIF 640 event_step(event) = on_step 641 n_events = event 642 ENDIF 643 644 END IF ! Event Detection Complete 645 646 647 !------------------------------------- 648 ! Now look for a label and a value 649 !------------------------------------- 650 651 if (eq2_pos .eq. 0) then 652 var_label = input_line(colon_pos+1: eq1_pos-1) 653 read( input_line(eq1_pos+1:linelen), *, iostat=ios) value_str 654 if(ios .ne. 0) then 655 CALL auto_error( ' AutoPilot ','Value Type Mismatch on NOW_STEP line!') 656 go to 20 657 end if 658 else 659 var_label = input_line(colon_pos+1: eq2_pos-1) 660 read( input_line(eq2_pos+1:linelen), *, iostat=ios) value_str 661 if(ios .ne. 0) then 662 CALL auto_error( ' AutoPilot ','Value Type Mismatch on ON_STEP line!') 663 go to 20 664 end if 665 endif 666 667 ! The Assignment must lie outside the new event scope since 668 ! there can exists more than one rule per event 669 670 IF ( (n_rules+1) .gt. max_rules) THEN 671 IF( ionode ) write(*,*) ' AutoPilot: current n_rules', n_rules 672 CALL auto_error( ' AutoPilot ', ' invalid number of rules ') 673 go to 20 674 END IF 675 676 call assign_rule(event, var_label, value_str) 677 678 !IF( ionode ) write(*,*) ' Number of rules: ', n_rules 679 680 FLUSH(6) 681 68220 CONTINUE 683 684 END SUBROUTINE add_rule 685 686 687 !----------------------------------------------------------------------- 688 ! ASSIGN_RULE 689 !----------------------------------------------------------------------- 690 SUBROUTINE assign_rule(event, var, value) 691 USE io_global, ONLY: ionode 692 IMPLICIT NONE 693 INTEGER :: i, event, varlen 694 CHARACTER(LEN=32) :: var 695 CHARACTER(LEN=32) :: value 696 INTEGER :: int_value 697 LOGICAL :: logical_value 698 REAL :: real_value 699 REAL(DP) :: realDP_value 700 LOGICAL :: assigned 701 LOGICAL, EXTERNAL :: matches 702 CHARACTER(LEN=1), EXTERNAL :: capital 703 704 705 var = TRIM(var) 706 varlen = LEN_TRIM(var) 707 708 DO i = 1, varlen 709 var( i : i ) = capital( var( i : i ) ) 710 END DO 711 712 713 IF( ionode ) write(*,'(" Reading rule: ",A20,A20)' ) var, value 714 assigned = .TRUE. 715 716 IF ( matches( "ISAVE", var ) ) THEN 717 read(value, *) int_value 718 rule_isave(event) = int_value 719 event_isave(event) = .true. 720 ELSEIF ( matches( "IPRINT", var ) ) THEN 721 read(value, *) int_value 722 rule_iprint(event) = int_value 723 event_iprint(event) = .true. 724 ELSEIF ( matches( "TPRINT", var ) ) THEN 725 read(value, *) logical_value 726 rule_tprint(event) = logical_value 727 event_tprint(event) = .true. 728 ELSEIF ( matches( "DT", var ) ) THEN 729 read(value, *) real_value 730 rule_dt(event) = real_value 731 event_dt(event) = .true. 732 !IF( ionode ) write(*,*) 'RULE_DT', rule_dt(event), 'EVENT', event 733 ELSEIF ( matches( "EMASS", var ) ) THEN 734 read(value, *) realDP_value 735 rule_emass(event) = realDP_value 736 event_emass(event) = .true. 737 ELSEIF ( matches( "ELECTRON_DYNAMICS", var ) ) THEN 738 read(value, *) value 739 if ((value .ne. 'SD') .and. (value .ne. 'VERLET') .and. (value .ne. 'DAMP') & 740 .and. (value .ne. 'NONE') .and. (value .ne. 'CG') ) then 741 call auto_error(' autopilot ',' unknown electron_dynamics '//trim(value) ) 742 assigned = .FALSE. 743 go to 40 744 endif 745 rule_electron_dynamics(event) = value 746 event_electron_dynamics(event) = .true. 747 ELSEIF ( matches( "ELECTRON_DAMPING", var ) ) THEN 748 read(value, *) realDP_value 749 rule_electron_damping(event) = realDP_value 750 event_electron_damping(event) = .true. 751 ELSEIF ( matches( "ION_DYNAMICS", var ) ) THEN 752 read(value, *) value 753 if ((value .ne. 'SD') .and. (value .ne. 'VERLET') .and. (value .ne. 'DAMP') .and. (value .ne. 'NONE')) then 754 call auto_error(' autopilot ',' unknown ion_dynamics '//trim(value) ) 755 assigned = .FALSE. 756 go to 40 757 endif 758 rule_ion_dynamics(event) = value 759 event_ion_dynamics(event) = .true. 760 ELSEIF ( matches( "ORTHOGONALIZATION", var) ) THEN 761 read(value, *) value 762 if ( (value .ne. 'ORTHO') .and. (value .ne. 'GRAM-SCHMIDT') ) then 763 call auto_error(' autopilot ',' unknown orthogonalization '//trim(value) ) 764 assigned = .false. 765 go to 40 766 endif 767 rule_electron_orthogonalization(event) = value 768 event_electron_orthogonalization(event) = .true. 769 ELSEIF ( matches( "ION_DAMPING", var ) ) THEN 770 read(value, *) realDP_value 771 rule_ion_damping(event) = realDP_value 772 event_ion_damping(event) = .true. 773 ELSEIF ( matches( "ION_TEMPERATURE", var ) ) THEN 774 read(value, *) value 775 if ((value .ne. 'NOSE') .and. (value .ne. 'NOT_CONTROLLED') .and. (value .ne. 'RESCALING')) then 776 call auto_error(' autopilot ',' unknown ion_temperature '//trim(value) ) 777 assigned = .FALSE. 778 go to 40 779 endif 780 rule_ion_temperature(event) = value 781 event_ion_temperature(event) = .true. 782 ELSEIF ( matches( "TEMPW", var ) ) THEN 783 read(value, *) realDP_value 784 rule_tempw(event) = realDP_value 785 event_tempw(event) = .true. 786 ELSEIF ( matches( "NHPCL", var ) ) THEN 787 read(value, *) int_value 788 rule_nhpcl(event) = int_value 789 event_nhpcl(event) = .true. 790 ELSEIF ( matches( "FNOSEP", var ) ) THEN 791 read(value, *) realDP_value 792 rule_fnosep(event) = realDP_value 793 event_fnosep(event) = .true. 794 ELSE 795 CALL auto_error( 'autopilot', ' ASSIGN_RULE: FAILED '//trim(var)//' '//trim(value) ) 796 END IF 797 79840 if (assigned) then 799 n_rules = n_rules + 1 800 else 801 IF( ionode ) write(*,*) ' Autopilot: Rule Assignment Failure ' 802 CALL auto_error( 'autopilot', ' ASSIGN_RULE: FAILED '//trim(var)//' '//trim(value) ) 803 endif 804 805 END SUBROUTINE assign_rule 806 807 808 809 810 !----------------------------------------------------------------------- 811 ! PARSE_MAILBOX 812 ! 813 ! Read the mailbox with a mailbox parser 814 ! if it starts with ON_STEP, then apply to event table etc 815 ! if not the try to establish that its a variable to set right now 816 !----------------------------------------------------------------------- 817 SUBROUTINE parse_mailbox () 818 USE io_global, ONLY: ionode 819 IMPLICIT NONE 820 INTEGER :: i 821 CHARACTER(LEN=256) :: input_line 822 LOGICAL :: tend 823 824 CHARACTER(LEN=1), EXTERNAL :: capital 825 LOGICAL, EXTERNAL :: matches 826 827 828 ! we can use this parser routine, since parse_unit=pilot_unit 829 CALL read_line( input_line, end_of_file=tend ) 830 IF (tend) GO TO 50 831 832 DO i = 1, LEN_TRIM( input_line ) 833 input_line( i : i ) = capital( input_line( i : i ) ) 834 END DO 835 836 ! This conditional implements the PAUSE feature calling init_auto_pilot, 837 ! will reset this modules global PAUSE_P variable to FALSE 838 IF ( matches( "PAUSE", input_line ) .or. & 839 matches( "SLEEP", input_line ) .or. & 840 matches( "HOVER", input_line ) .or. & 841 matches( "WAIT", input_line ) .or. & 842 matches( "HOLD", input_line ) ) THEN 843 844 IF( ionode ) write(*,*) 'SLEEPING' 845 IF( ionode ) write(*,*) 'INPUT_LINE=', input_line 846 pause_p = .TRUE. 847 ! now you can pass continue to resume 848 ELSE IF (matches( "CONTINUE", input_line ) .or. & 849 matches( "RESUME", input_line ) ) THEN 850 IF( ionode ) write(*,*) 'RUNNING' 851 IF( ionode ) write(*,*) 'INPUT_LINE=', input_line 852 pause_p = .FALSE. 853 854 ! Now just quit this subroutine 855 ELSE 856 ! Also, We didnt see a PAUSE cmd! 857 pause_p = .FALSE. 858 859 ! now lets detect the mode for card_autopilot 860 ! even though this line will be passed to it the first time 861 862 IF ( matches( "AUTOPILOT", TRIM(input_line) ) ) THEN 863 IF( ionode ) WRITE(*,*) ' New autopilot course detected' 864 pilot_type ='AUTO' 865 ELSE IF (matches( "PILOT", TRIM(input_line) ) ) THEN 866 IF( ionode ) WRITE(*,*) ' Relative pilot course correction detected' 867 pilot_type ='PILOT' 868 ELSE IF (matches( "NOW", TRIM(input_line) ) ) THEN 869 IF( ionode ) WRITE(*,*) ' Manual piloting detected' 870 pilot_type ='MANUAL' 871 ELSE 872 ! Well lets just pause since this guys is throwing trash 873 IF( ionode ) WRITE(*,*) ' Mailbox contents not understood: pausing' 874 pause_p = .TRUE. 875 ENDIF 876 877 END IF 878 879 IF (pause_p) GO TO 50 880 881 882 ! ok if one adds a rule during steering` 883 ! event table must be cleared (from steer point) forward 884 ! 885 ! Every nodes gets this (and the call to card_autopilot 886 ! which calls add_rule, which calls assign_rule, etc 887 ! In this way we sync the event table 888 ! Then we shouldn't have to sync employ_rules variable 889 ! changes, or their subroutine side effects (like ions_nose_init) 890 891 CALL init_autopilot() 892 893 CALL card_autopilot( input_line ) 894 89550 CONTINUE 896 897 end subroutine parse_mailbox 898 899 900END MODULE autopilot 901 902