! cp_autopilot.f90
!********************************************************************************
! cp_autopilot.f90                             Copyright (c) 2005 Targacept, Inc.
!********************************************************************************
!   The Autopilot Feature suite is a user level enhancement that enables the 
! following features:  
!      automatic restart of a job; 
!      preconfiguration of job parameters; 
!      on-the-fly changes to job parameters; 
!      and pausing of a running job.  
!
! For more information, see AUTOPILOT in document directory.
!
! This program is free software; you can redistribute it and/or modify it under 
! the terms of the GNU General Public License as published by the Free Software 
! Foundation; either version 2 of the License, or (at your option) any later version.
! This program is distributed in the hope that it will be useful, but WITHOUT ANY 
! WARRANTY; without even the implied warranty of MERCHANTABILITY FOR A PARTICULAR 
! PURPOSE.  See the GNU General Public License at www.gnu.or/copyleft/gpl.txt for 
! more details.
! 
! THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  
! EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES 
! PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED, 
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 
! FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND THE 
! PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, 
! YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
!
! IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING, 
! WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE 
! THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY 
! GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR 
! INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA 
! BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A 
! FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER 
! OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
!
! You should have received a copy of the GNU General Public License along with 
! this program; if not, write to the 
! Free Software Foundation, Inc., 
! 51 Franklin Street, 
! Fifth Floor, 
! Boston, MA  02110-1301, USA.
! 
! Targacept's address is 
! 200 East First Street, Suite 300
! Winston-Salem, North Carolina USA 27101-4165 
! Attn: Molecular Design. 
! Email: atp@targacept.com
!
! This work was supported by the Advanced Technology Program of the 
! National Institute of Standards and Technology (NIST), Award No. 70NANB3H3065 
!
!********************************************************************************

!********************************************************************************
! 04/2018
! Implemented switch from CG to Verlet and from Verlet to CG.
! The code automagically set the correct wfc velocity after the last CG step,
! and inizialize again the mass of the electron mu(k) after the CG.
! Note that CG modifies the array of the electron mass.
!
! Riccardo Bertossa, Federico Grasselli
!   (SISSA - via Bonomea, 265 - 34136 Trieste ITALY)
!********************************************************************************
!06/2018
!Implemented on the fly change of timestep (with correct rescaling of the
!velocities)
!
! Riccardo Bertossa
!********************************************************************************



MODULE cp_autopilot
  !---------------------------------------------------------------------------
  !! This module handles the Autopilot Feature Suite.  
  !! Written by Lee Atkinson, with help from the ATP team at Targacept, Inc  
  !! Created June 2005  
  !! Modified by Yonas Abrahm Sept 2006
  !
  !   The address for Targacept, Inc. is:
  !     200 East First Street, Suite
  !     300, Winston-Salem, North Carolina 27101; 
  !     Attn: Molecular Design.
  !
  !! See README.AUTOPILOT in the Doc directory for more information.
  !---------------------------------------------------------------------------

  USE kinds
  USE autopilot, ONLY : current_nfi, pilot_p, pilot_unit, pause_p,auto_error, &
        &  parse_mailbox, rule_isave, rule_iprint, rule_dt, rule_emass,       &
        &  rule_electron_dynamics, rule_electron_damping, rule_ion_dynamics, &
        &  rule_ion_damping,  rule_ion_temperature, rule_tempw, &
        &  rule_electron_orthogonalization, rule_tprint, &
        &  rule_nhpcl, rule_fnosep
  USE autopilot, ONLY : event_index, event_step, event_isave, event_iprint, &
        &  event_dt, event_emass, event_electron_dynamics, event_electron_damping, &
        &  event_ion_dynamics, event_ion_damping, event_ion_temperature, event_tempw, &
        & event_electron_orthogonalization, &
        & event_tprint, &
        & event_nhpcl, event_fnosep

  IMPLICIT NONE
  SAVE


  PRIVATE
  PUBLIC ::  pilot, employ_rules
  LOGICAL, PRIVATE :: had_tcg_true = .false.
  LOGICAL, PRIVATE :: had_tens_true = .false.
CONTAINS

  


  !-----------------------------------------------------------------------
  ! EMPLOY_RULES
  !-----------------------------------------------------------------------
  SUBROUTINE employ_rules()
    USE input_parameters, ONLY :   dt, & 
         &  electron_dynamics, electron_damping, &
         & ion_dynamics, ion_damping, &
         & ion_temperature, fnosep, nhpcl, nhptyp, nhgrp, fnhscl, ndega, nat, &
         & orthogonalization
    use ions_nose, ONLY: tempw
    USE control_flags, only: tsde, tsdp, tfor, tcp, tnosep, isave,iprint,&
                             tconvthrs, tolp, &
                             ekin_conv_thr, forc_conv_thr, etot_conv_thr,&
                             tortho, tfirst, tlast, tprint
    use wave_base, only: frice
    use ions_base, only: fricp
    USE ions_nose, ONLY: ions_nose_init,xnhp0, xnhpm, ions_nose_deallocate
    USE ions_positions,        ONLY : taus, tausm
    USE io_global, ONLY: ionode, ionode_id
    USE time_step,                ONLY : set_time_step,tps
    USE cp_electronic_mass,       ONLY: emass, emass_cutoff, emass_precond
    USE cg_module,                ONLY : tcg,allocate_cg,cg_info, &
                                         nfi_firstcg,c0old
    USE wavefunctions,     ONLY : cm_bgrp,c0_bgrp
    USE ensemble_dft,             ONLY : tens,allocate_ensemble_dft
    USE uspp,                     ONLY : nkb, nkbus
    USE electrons_base,           ONLY : nspin, nbsp, nbspx, nudx
    USE gvecw,                    ONLY : ngw
    USE fft_base,                 ONLY : dffts
    USE cp_main_variables,        ONLY : idesc, lambdap, lambda, lambdam
    USE ions_base,                ONLY : nat_ions_base => nat 
    USE cell_base,                ONLY : tpiba2
    USE cp_main_variables,        ONLY : ema0bg
    USE gvecw,                    ONLY : g2kin, ngw 

    IMPLICIT NONE

    REAL(DP) :: old_tps
    
    !----------------------------------------
    !     &CONTROL
    !----------------------------------------

    ! ISAVE
    if (event_isave(event_index)) then
       isave            = rule_isave(event_index)
       IF ( ionode ) write(*,'(4X,A,15X,I10)') 'Rule event: isave', isave
    endif

    ! IPRINT
    if (event_iprint(event_index)) then
       iprint           = rule_iprint(event_index)
       IF ( ionode ) write(*,'(4X,A,13X,I10)') 'Rule event: iprint', iprint
    endif

    ! TPRINT
    if (event_tprint(event_index)) then
       tprint           = rule_tprint(event_index)
       IF ( ionode ) write(*,*) 'NUOVO Rule event: tprint', tprint
    endif

    ! DT
    if (event_dt(event_index)) then
       IF ( ionode ) write(*,'(4X,A,18X,F10.4)') 'Rule event: dt',rule_dt(event_index)
       IF (dt /= rule_dt(event_index) ) THEN
          IF  (.NOT. ( tcg .OR. tsde ) ) THEN !if I am doing verlet for electrons
             !rescale electron velocities (wavefunctions and lagrange
             !multipliers) 
             IF ( ionode ) write(*,*) 'Rescaling electronic velocities with new dt' 
             lambdam = lambda - (lambda-lambdam)*rule_dt(event_index)/dt
             cm_bgrp = c0_bgrp - (c0_bgrp-cm_bgrp)*rule_dt(event_index)/dt
          END IF
          IF ( (.NOT. tsdp) .AND. tfor ) THEN !if I am doing verlet for ions
             !rescale ionic velocities (ions and nose variables)
             IF ( ionode ) write(*,*) 'Rescaling ionic velocities with new dt'
             tausm = taus - (taus-tausm)*rule_dt(event_index)/dt
             xnhpm = xnhp0 - (xnhp0-xnhpm)*rule_dt(event_index)/dt
          END IF
       END IF
       dt               = rule_dt(event_index)
       old_tps=tps 
       CALL set_time_step( dt ) !this subroutine sets to zero the elapsed time tps
       tps=old_tps
    endif

    !----------------------------------------
    !     &SYSTEM
    !----------------------------------------

    !----------------------------------------
    !     &ELECTRONS
    !----------------------------------------
    
    
    if (event_electron_orthogonalization(event_index)) then
       orthogonalization=rule_electron_orthogonalization(event_index)
       select case (orthogonalization)
       case ('ORTHO')
           tortho=.true.
           IF ( ionode ) write(*,*) 'Wow, setting tortho=.true. !' 
       case ('GRAM-SCHMIDT')
           tortho=.false.
           IF ( ionode ) write(*,*) 'Wow, setting tortho=.false. ! (Ma cossa xe sta monada?)' 
       case default 
           call auto_error(' autopilot ',' unknown orthogonalization'//trim(orthogonalization) )
       end select

    endif

    ! EMASS    
    if (event_emass(event_index)) then
       emass            = rule_emass(event_index)
       IF ( ionode ) write(*,'(4X,A,15X,F10.4)') 'Rule event: emass', emass
    endif

    ! ELECTRON_DYNAMICS   
    ! electron_dynamics = 'sd' | 'verlet' | 'damp' | 'none'
    if (event_electron_dynamics(event_index)) then
       electron_dynamics= rule_electron_dynamics(event_index)
       frice = 0.d0
       ! the cg algorithm uses cm for its internal purposes. The true cm is
       ! c0old, so now I have to copy it into cm
       if ( tcg ) then
           cm_bgrp=c0old
           ! tfirst=.true.   !check if this is needed (I don't think so)
           ! the conjugate gradient method modifies the electron mass mu(k),
           ! by calling the routine
           ! emass_precond_tpa( ema0bg, tpiba2, emass_cutoff )
           ! so I call here the standard routine to set mu(k)
           CALL emass_precond( ema0bg, g2kin, ngw, tpiba2, emass_cutoff)

       endif
       select case ( electron_dynamics ) 
       case ('SD')
          tsde  = .true.
          tcg=.false.
       case ('VERLET')
          tsde  = .false.
          tcg=.false.
       case ('DAMP')
          tsde  = .false.
          frice = electron_damping
          tcg=.false.
       case ('NONE')
          tsde  = .false.
          tcg=.false.
       case ('CG')
          tsde=.false.
          IF ( ionode ) write(*,*) 'Wow, setting tcg=.true. at step '&
                 ,current_nfi,' ! (La ghe domandi a mia molie)'
          if (.not. tcg) then
              nfi_firstcg=current_nfi  !the first step is different!
          end if
          if (.not. had_tcg_true) then
              had_tcg_true=.true.
              if (.not. had_tens_true) then
                  CALL allocate_ensemble_dft( nkb, nbsp, ngw, nudx, nspin, nbspx, &
                                 dffts%nnr, nat_ions_base, idesc )
              endif
              CALL allocate_cg( ngw, nbspx,nkbus )              
          endif
          CALL cg_info()
          tcg = .true.
       case default
          call auto_error(' autopilot ',' unknown electron_dynamics '//trim(electron_dynamics) )
       end select

       IF ( ionode ) write(*,'(4X,A,2X,A10)') 'Rule event: electron_dynamics', electron_dynamics

    endif


    ! ELECTRON_DAMPING   
    if (event_electron_damping(event_index)) then
       ! meaningful only if " electron_dynamics = 'damp' "
       electron_damping = rule_electron_damping(event_index)
       frice = electron_damping
       IF ( ionode ) write(*,'(4X,A,4X,F10.4)') 'Rule event: electron_damping', electron_damping
    endif

    !----------------------------------------
    !     &IONS
    !----------------------------------------


    ! ION_DYNAMICS   
    ! ion_dynamics = 'sd' | 'verlet' | 'damp' | 'none'
    if (event_ion_dynamics(event_index)) then
      ion_dynamics= rule_ion_dynamics(event_index)
      tconvthrs%active = .FALSE.
      tconvthrs%nstep  = 1
      tconvthrs%ekin   = 0.0d0
      tconvthrs%derho  = 0.0d0
      tconvthrs%force  = 0.0d0

       select case ( ion_dynamics ) 
       case ('SD')
          tsdp = .true.
          tfor = .true.
          fricp= 0.d0
          tconvthrs%ekin   = ekin_conv_thr
          tconvthrs%derho  = etot_conv_thr
          tconvthrs%force  = forc_conv_thr
          tconvthrs%active = .TRUE.
          tconvthrs%nstep  = 1
       case ('VERLET')
          tsdp = .false.
          tfor = .true.
          fricp= 0.d0
       case ('DAMP')
          tsdp = .false.
          tfor = .true.
          fricp= ion_damping
          tconvthrs%ekin   = ekin_conv_thr
          tconvthrs%derho  = etot_conv_thr
          tconvthrs%force  = forc_conv_thr
          tconvthrs%active = .TRUE.
          tconvthrs%nstep  = 1
       case ('NONE')
          tsdp = .false.
          tfor = .false.
          fricp= 0.d0
       case default
          call auto_error(' iosys ',' unknown ion_dynamics '//trim(ion_dynamics) )
       end select

    endif


    ! ION_DAMPING   
    if (event_ion_damping(event_index)) then
       ! meaningful only if " ion_dynamics = 'damp' "
       ion_damping = rule_ion_damping(event_index)
       IF ( ionode ) write(*,'(4X,A,9X,F10.4)') 'Rule event: ion_damping', ion_damping
    endif


    ! ION_TEMPERATURE 
    if (event_ion_temperature(event_index)) then
       ion_temperature = rule_ion_temperature(event_index)
      tcp      = .FALSE.
      tnosep   = .FALSE.
      tolp     = tolp
       select case ( ion_temperature ) 
          !         temperature control of ions via nose' thermostat
          !         tempw (real(DP))  frequency (in which units?)
          !         fnosep (real(DP))  temperature (in which units?)
       case ('NOSE')
          tnosep = .true.
          tcp = .false.
          if ( .not. event_tempw(event_index)) then
              IF ( ionode ) write(*,*) 'WARNING: missing tempw event (if undefined can make the code bananas) '
          end if
          if ( .not. tfor) then
              IF ( ionode ) write(*,*) 'WARNING: not doing Verlet on ions? (am I correct?)'
          end if
       case ('NOT_CONTROLLED')
          tnosep = .false.
          tcp = .false.
       case ('RESCALING' )
          tnosep = .false.
          tcp = .true.
       case default
          call auto_error(' iosys ',' unknown ion_temperature '//trim(ion_temperature) )
       end select

       IF ( ionode ) write(*,'(4X,A,5X,A)') 'Rule event: ion_temperature', ion_temperature

    endif

    ! TEMPW
    if (event_tempw(event_index)) then
       tempw  = rule_tempw(event_index)
       ! The follwiong is a required side effect
       ! when resetting tempw
       IF ( ionode ) write(*,'(4X,A,15X,F10.4)') 'Rule event: tempw', tempw
    endif

    ! NHPCL
    if (event_nhpcl(event_index)) then
       nhpcl = rule_nhpcl(event_index)
       call ions_nose_deallocate() ! the dimension of the nose array can change
       if ( ionode ) write(*,'(4X,A,15X,I1)') 'Rule event: nhpcl', nhpcl
       
    endif

    ! FNOSEP
    ! TODO: implement reading of full FNOSEP array
    if (event_fnosep(event_index)) then
       fnosep = rule_fnosep(event_index)
       if ( ionode ) then
           write(*,'(4X,A,15X,F10.4)') 'Rule event: fnosep', fnosep(1)
           write(*,'(4X,A)') 'WARNING: all fnosep of the chain are set to the same value'
       endif
       
       !IF ( ionode ) write(*,*) 'Rule event: fnosep', fnosep
    endif

    ! nose initialization
    if (event_tempw(event_index) .or. event_nhpcl(event_index) .or. event_fnosep(event_index) .or. &
            (event_ion_temperature(event_index) .and. rule_ion_temperature(event_index) .eq. 'NOSE'  ) &
        ) then
       call ions_nose_init( tempw, fnosep, nhpcl, nhptyp, ndega, nhgrp, fnhscl)
    endif

    !----------------------------------------
    !     &CELL
    !----------------------------------------

    !----------------------------------------
    !     &PHONON
    !----------------------------------------


  END SUBROUTINE employ_rules



  !-----------------------------------------------------------------------
  ! PILOT
  !-----------------------------------------------------------------------
  subroutine pilot (nfi)
    !! Here is the main pilot routine called in CPR, at the top
    !! of the basic dynamics loop just after nose hoover update.
    !
    USE parser, ONLY: parse_unit
    USE io_global, ONLY: ionode, ionode_id
    USE mp,        ONLY : mp_bcast, mp_barrier
    USE mp_world,  ONLY : world_comm
#if defined (__NAG)
    USE f90_unix_proc
#endif
    USE ensemble_dft,             ONLY : tens
    USE cg_module, ONLY : tcg
    USE control_flags , only : tprint

    IMPLICIT NONE
    INTEGER :: nfi
    LOGICAL :: file_p
    CHARACTER (LEN=256) :: mbfile = "pilot.mb"

    ! The tcg control variable, that enables conjugate gradient electron
    ! dynamics, allocates some arrays when used in the input file. So I check
    ! if this variable is defined, and set had_tcg_true to true.

    if (tcg) had_tcg_true = .true.
    if (tens) had_tens_true = .true.

    ! Dynamics Loop Started
    pilot_p   = .TRUE.

    ! This is so we can usurp the exiting parser
    ! that defaults to stdin (unit=5)
    ! We have to do it this way if we are to 
    ! call (reuse) the card_autopilot that is called
    ! by read_cards
    parse_unit = pilot_unit

    ! Our own local for nfi
    current_nfi = nfi


    ! This allows one pass. Calling parse_mailbox will either:
    ! 1) call init_auto_pilot, which will always set this modules global PAUSE_P variable to FALSE
    ! 2) detect a pause indicator, setting PAUSE_P to TRUE until a new mailbox overrides.
    pause_loop: do

       file_p = .FALSE.
       IF ( ionode ) INQUIRE( FILE = TRIM( mbfile ), EXIST = file_p )
       call mp_bcast(file_p, ionode_id,world_comm)

       IF ( file_p ) THEN

          IF ( ionode ) THEN
            WRITE(*,*)
            WRITE(*,*) '****************************************************'
            WRITE(*,*) '  Autopilot: Mailbox found at nfi=', current_nfi
          END IF
          FLUSH(6)

          ! Open the mailbox
          IF ( ionode ) OPEN( UNIT = pilot_unit, FILE = TRIM( mbfile ) )

          ! Will reset PAUSE_P to false unless there is a PAUSE cmd
          ! The following call is MPI safe! It only generates side effects
          CALL parse_mailbox()
          call mp_barrier( world_comm )
          
          IF ( ionode ) THEN
            WRITE(*,*) '  Autopilot: Done reading mailbox' 
            WRITE(*,*) '****************************************************'
            WRITE(*,*)
          END IF

          ! Perhaps instead of deleting move the file as an input log     
          IF( ionode ) CLOSE( UNIT = pilot_unit, STATUS = 'DELETE' )

       END IF

       IF( .NOT. pause_p ) THEN
          EXIT pause_loop
       ELSE
          IF( ionode ) write(*,*) 'SLEEPING .... send another pilot.mb'
          call sleep (5)
       END if

    end do pause_loop




    ! Autopilot (Dynamic Rules) Implementation
    ! When nfi has passed (is greater than
    ! the next event, then employ rules
    ! Mailbox may have issued several rules
    ! Attempt to catch up! 
    do while (current_nfi >= event_step(event_index) )         

       IF ( ionode ) THEN
          WRITE(*,*)
          WRITE(*,*) '****************************************************'
          WRITE(*,*) '  Autopilot employ rules: '
       END IF
       call employ_rules()
       IF ( ionode ) THEN
          WRITE(*,*) '****************************************************'
          WRITE(*,*)
       END IF
       call mp_barrier( world_comm )

       ! update event_index to current
       event_index = event_index + 1

    enddo
    
    ! During the last step of electron conjugate gradient,
    ! set tprint to .true. if next step has electron_dynamics = Verlet
    ! This is needed to calculate wavefunctions at time t and (t - dt)
    if (need_tprint_true() ) then
       tprint = .true.
       if (ionode) then
            WRITE(*,*) '=================================================='
            WRITE(*,*) ' Setting tprint=.true. for this step (last of CG)'
            WRITE(*,*) '=================================================='
       endif
    endif

  end subroutine pilot

  function  need_tprint_true()
      !! Check if next step is a Verlet. In such case returns .TRUE.  
      !! Used whenever \(\text{tprint}=\text{.TRUE.}\) is needed, e.g. to let CG
      !! calculate wavefunctions at time t and (t - dt) via projections
      !! onto the occupied manifold.  
      !! This function has to be called after \(\texttt{call employ_rules}()\)!
      !
      USE cg_module, ONLY : tcg
      !
      LOGICAL :: need_tprint_true
      INTEGER :: event_idx
      !
      need_tprint_true = .FALSE.
      event_idx = event_index
      do while ( event_idx .le. size(event_step) .and. (event_step(event_idx)==current_nfi+1) ) 
          if ( tcg  .and. event_electron_dynamics(event_idx) .and. &
            &  (rule_electron_dynamics(event_idx)=='VERLET') ) then
               need_tprint_true = .TRUE.
          end if 
          event_idx = event_idx + 1
      enddo
      RETURN
  end function need_tprint_true

END MODULE cp_autopilot

