LCOV - code coverage report
Current view: top level - src/tmc - tmc_messages.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:9f1e18e) Lines: 598 734 81.5 %
Date: 2021-09-22 20:58:48 Functions: 19 24 79.2 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------------------------!
       2             : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3             : !   Copyright 2000-2021 CP2K developers group <https://cp2k.org>                                   !
       4             : !                                                                                                  !
       5             : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6             : !--------------------------------------------------------------------------------------------------!
       7             : 
       8             : ! **************************************************************************************************
       9             : !> \brief set up the different message for different tasks
      10             : !>      A TMC message consists of 3 parts (messages)
      11             : !>      1: first a message with task type (STATUS) and SIZES of submessages
      12             : !>      2: (if existing) a message with INTEGER values
      13             : !>      3: (if existing) a message with REAL values
      14             : !>      submessages 2 and 3 include relevant data, e.g. positions, box sizes...
      15             : !> \par History
      16             : !>      11.2012 created [Mandes Schoenherr]
      17             : !> \author Mandes
      18             : ! **************************************************************************************************
      19             : MODULE tmc_messages
      20             :    USE cp_log_handling,                 ONLY: cp_to_string
      21             :    USE cp_para_types,                   ONLY: cp_para_env_type
      22             :    USE kinds,                           ONLY: default_string_length,&
      23             :                                               dp
      24             :    USE message_passing,                 ONLY: mp_any_source,&
      25             :                                               mp_any_tag,&
      26             :                                               mp_bcast,&
      27             :                                               mp_probe,&
      28             :                                               mp_recv,&
      29             :                                               mp_send
      30             :    USE tmc_move_handle,                 ONLY: add_mv_prob
      31             :    USE tmc_stati,                       ONLY: &
      32             :         TMC_CANCELING_MESSAGE, TMC_CANCELING_RECEIPT, TMC_STATUS_CALCULATING, TMC_STATUS_FAILED, &
      33             :         TMC_STATUS_STOP_RECEIPT, TMC_STATUS_WAIT_FOR_NEW_TASK, TMC_STATUS_WORKER_INIT, &
      34             :         TMC_STAT_ANALYSIS_REQUEST, TMC_STAT_ANALYSIS_RESULT, TMC_STAT_APPROX_ENERGY_REQUEST, &
      35             :         TMC_STAT_APPROX_ENERGY_RESULT, TMC_STAT_ENERGY_REQUEST, TMC_STAT_ENERGY_RESULT, &
      36             :         TMC_STAT_INIT_ANALYSIS, TMC_STAT_MD_BROADCAST, TMC_STAT_MD_REQUEST, TMC_STAT_MD_RESULT, &
      37             :         TMC_STAT_NMC_BROADCAST, TMC_STAT_NMC_REQUEST, TMC_STAT_NMC_RESULT, &
      38             :         TMC_STAT_SCF_STEP_ENER_RECEIVE, TMC_STAT_START_CONF_REQUEST, TMC_STAT_START_CONF_RESULT, &
      39             :         task_type_gaussian_adaptation
      40             :    USE tmc_tree_build,                  ONLY: allocate_new_sub_tree_node
      41             :    USE tmc_tree_types,                  ONLY: elem_array_type,&
      42             :                                               elem_list_type,&
      43             :                                               tree_type
      44             :    USE tmc_types,                       ONLY: allocate_tmc_atom_type,&
      45             :                                               tmc_atom_type,&
      46             :                                               tmc_param_type
      47             : #include "../base/base_uses.f90"
      48             : 
      49             :    IMPLICIT NONE
      50             : 
      51             :    PRIVATE
      52             : 
      53             :    LOGICAL, PARAMETER, PUBLIC                 :: send_msg = .TRUE.
      54             :    LOGICAL, PARAMETER, PUBLIC                 :: recv_msg = .FALSE.
      55             : 
      56             :    INTEGER, PARAMETER                         :: message_end_flag = 25
      57             : 
      58             :    INTEGER, PARAMETER                         :: DEBUG = 0
      59             : 
      60             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'tmc_messages'
      61             : 
      62             :    PUBLIC :: check_if_group_master
      63             :    PUBLIC :: tmc_message
      64             :    PUBLIC :: communicate_atom_types
      65             :    PUBLIC :: stop_whole_group
      66             : 
      67             :    INTEGER, PARAMETER, PUBLIC :: MASTER_COMM_ID = 0 ! id for master and group master
      68             :    INTEGER, PARAMETER, PUBLIC :: bcast_group = -1 ! destination flag for broadcasting to other group participants
      69             :    INTEGER, PARAMETER :: TMC_SEND_INFO_SIZE = 4 ! usually: 1. status, array sizes: 2. int, 3. real, 4. char
      70             : 
      71             :    TYPE message_send
      72             :       INTEGER, DIMENSION(TMC_SEND_INFO_SIZE)   :: info
      73             :       REAL(KIND=dp), DIMENSION(:), ALLOCATABLE :: task_real
      74             :       INTEGER, DIMENSION(:), ALLOCATABLE       :: task_int
      75             :       CHARACTER, DIMENSION(:), ALLOCATABLE     :: task_char
      76             :       !should be deleted somewhen
      77             :       INTEGER, DIMENSION(:), ALLOCATABLE :: elem_stat
      78             :    END TYPE message_send
      79             : 
      80             : CONTAINS
      81             : 
      82             : ! **************************************************************************************************
      83             : !> \brief checks if the core is the group master
      84             : !> \param para_env defines the mpi communicator
      85             : !> \return return value, logical
      86             : !> \author Mandes 01.2013
      87             : ! **************************************************************************************************
      88          14 :    FUNCTION check_if_group_master(para_env) RESULT(master)
      89             :       TYPE(cp_para_env_type), POINTER                    :: para_env
      90             :       LOGICAL                                            :: master
      91             : 
      92          14 :       CPASSERT(ASSOCIATED(para_env))
      93             : 
      94          14 :       master = .FALSE.
      95          14 :       IF (para_env%mepos .EQ. MASTER_COMM_ID) &
      96          14 :          master = .TRUE.
      97          14 :    END FUNCTION check_if_group_master
      98             : 
      99             : ! **************************************************************************************************
     100             : !> \brief tmc message handling, packing messages with integer and real data
     101             : !>        type. Send first info message with task type and message sizes and
     102             : !>        then the int and real messages. The same for receiving
     103             : !> \param msg_type defines the message types, see message tags definition
     104             : !> \param send_recv 1= send, 0= receive
     105             : !> \param dest defines the target or source of message
     106             : !>              (-1=braodcast, 0= master, 1... working group)
     107             : !> \param para_env defines the mpi communicator
     108             : !> \param tmc_params stuct with parameters (global settings)
     109             : !> \param elem a subtree element from which info are readed or written in
     110             : !> \param elem_array ...
     111             : !> \param list_elem ...
     112             : !> \param result_count ...
     113             : !> \param wait_for_message ...
     114             : !> \param success ...
     115             : !> \author Mandes 12.2012
     116             : ! **************************************************************************************************
     117      521639 :    SUBROUTINE tmc_message(msg_type, send_recv, dest, para_env, tmc_params, &
     118      521639 :                           elem, elem_array, list_elem, result_count, &
     119             :                           wait_for_message, success)
     120             :       INTEGER                                            :: msg_type
     121             :       LOGICAL                                            :: send_recv
     122             :       INTEGER                                            :: dest
     123             :       TYPE(cp_para_env_type), POINTER                    :: para_env
     124             :       TYPE(tmc_param_type), POINTER                      :: tmc_params
     125             :       TYPE(tree_type), OPTIONAL, POINTER                 :: elem
     126             :       TYPE(elem_array_type), DIMENSION(:), OPTIONAL      :: elem_array
     127             :       TYPE(elem_list_type), OPTIONAL, POINTER            :: list_elem
     128             :       INTEGER, DIMENSION(:), OPTIONAL, POINTER           :: result_count
     129             :       LOGICAL, OPTIONAL                                  :: wait_for_message, success
     130             : 
     131             :       INTEGER                                            :: i, message_tag, tmp_tag
     132             :       LOGICAL                                            :: act_send_recv, flag
     133             :       TYPE(message_send), POINTER                        :: m_send
     134             : 
     135      521639 :       CPASSERT(ASSOCIATED(para_env))
     136      521639 :       CPASSERT(ASSOCIATED(tmc_params))
     137             : 
     138      521639 :       ALLOCATE (m_send)
     139             : 
     140             :       ! init
     141             :       ! define send_recv flag for broadcast
     142      521639 :       IF (dest .EQ. bcast_group) THEN
     143             :          ! master should always send
     144        2215 :          IF (para_env%mepos .EQ. MASTER_COMM_ID) THEN
     145             :             act_send_recv = send_msg
     146             :          ELSE
     147             :             ! worker should always receive
     148             :             act_send_recv = recv_msg
     149             :          END IF
     150             :       ELSE
     151      519424 :          act_send_recv = send_recv
     152             :       END IF
     153        2215 :       message_tag = 0
     154             : 
     155             :       ! =============================
     156             :       ! sending message
     157             :       ! =============================
     158             :       ! creating message to send
     159      519424 :       IF (act_send_recv .EQV. send_msg) THEN
     160             :          IF ((DEBUG .GE. 7) .AND. (dest .NE. bcast_group) .AND. &
     161             :              (dest .NE. MASTER_COMM_ID)) THEN
     162             :             IF (PRESENT(elem)) THEN
     163             :                WRITE (*, *) "send element info to ", dest, " of type ", msg_type, "of subtree", elem%sub_tree_nr, &
     164             :                   "elem", elem%nr
     165             :             ELSE
     166             :                WRITE (*, *) "send element info to ", dest, " of type ", msg_type
     167             :             END IF
     168             :          END IF
     169        6582 :          SELECT CASE (msg_type)
     170             :          CASE (TMC_STAT_START_CONF_REQUEST, TMC_STATUS_FAILED, TMC_CANCELING_MESSAGE, &
     171             :                TMC_CANCELING_RECEIPT, TMC_STATUS_STOP_RECEIPT, &
     172             :                TMC_STATUS_WAIT_FOR_NEW_TASK, TMC_STATUS_CALCULATING, &
     173             :                TMC_STAT_ANALYSIS_RESULT)
     174         195 :             CALL create_status_message(m_send)
     175             :          CASE (TMC_STATUS_WORKER_INIT)
     176          28 :             CALL create_worker_init_message(tmc_params, m_send)
     177             :          CASE (TMC_STAT_START_CONF_RESULT, TMC_STAT_INIT_ANALYSIS)
     178          28 :             CALL create_start_conf_message(msg_type, elem, result_count, tmc_params, m_send)
     179             :          CASE (TMC_STAT_ENERGY_REQUEST, TMC_STAT_APPROX_ENERGY_REQUEST)
     180        3986 :             CALL create_energy_request_message(elem, m_send, tmc_params)
     181             :          CASE (TMC_STAT_APPROX_ENERGY_RESULT)
     182          14 :             CALL create_approx_energy_result_message(elem, m_send, tmc_params)
     183             :          CASE (TMC_STAT_ENERGY_RESULT)
     184        1979 :             CALL create_energy_result_message(elem, m_send, tmc_params)
     185             :          CASE (TMC_STAT_NMC_REQUEST, TMC_STAT_NMC_BROADCAST, &
     186             :                TMC_STAT_MD_REQUEST, TMC_STAT_MD_BROADCAST)
     187         114 :             CALL create_NMC_request_massage(msg_type, elem, m_send, tmc_params)
     188             :          CASE (TMC_STAT_MD_RESULT, TMC_STAT_NMC_RESULT)
     189          57 :             CALL create_NMC_result_massage(msg_type, elem, m_send, tmc_params)
     190             :          CASE (TMC_STAT_ANALYSIS_REQUEST)
     191           0 :             CPASSERT(PRESENT(list_elem))
     192           0 :             CALL create_analysis_request_message(list_elem, m_send, tmc_params)
     193             :          CASE DEFAULT
     194        6387 :             CPABORT("try to send unknown message type "//cp_to_string(msg_type))
     195             :          END SELECT
     196             :          !set message info
     197        6387 :          message_tag = msg_type
     198       31935 :          m_send%info(:) = 0
     199        6387 :          m_send%info(1) = msg_type
     200        6387 :          IF (ALLOCATED(m_send%task_int)) m_send%info(2) = SIZE(m_send%task_int)
     201        6387 :          IF (ALLOCATED(m_send%task_real)) m_send%info(3) = SIZE(m_send%task_real)
     202        6387 :          IF (ALLOCATED(m_send%task_char)) m_send%info(4) = SIZE(m_send%task_char)
     203             :       END IF
     204             : 
     205             :       ! sending message
     206      521639 :       IF ((act_send_recv .EQV. send_msg) .AND. (dest .NE. bcast_group)) THEN
     207        4172 :          CALL mp_send(m_send%info, dest, message_tag, para_env%group)
     208        4172 :          IF (m_send%info(2) .GT. 0) THEN
     209        2135 :             CALL mp_send(m_send%task_int, dest, message_tag, para_env%group)
     210             :          END IF
     211        4172 :          IF (m_send%info(3) .GT. 0) THEN
     212        4128 :             CALL mp_send(m_send%task_real, dest, message_tag, para_env%group)
     213             :          END IF
     214        4172 :          IF (m_send%info(4) .GT. 0) THEN
     215           0 :             CPABORT("")
     216             :             !TODO send characters CALL mp_send(m_send%task_char, dest, message_tag, para_env%group)
     217             :          END IF
     218             :          IF (DEBUG .GE. 1) &
     219             :             WRITE (*, *) "TMC|message: ID: ", para_env%mepos, &
     220             :             " send element info to   ", dest, " of stat ", m_send%info(1), &
     221             :             " with size int/real/char", m_send%info(2:), " with comm ", &
     222             :             para_env%group, " and tag ", message_tag
     223        4172 :          IF (m_send%info(2) .GT. 0) DEALLOCATE (m_send%task_int)
     224        4172 :          IF (m_send%info(3) .GT. 0) DEALLOCATE (m_send%task_real)
     225        4172 :          IF (m_send%info(4) .GT. 0) DEALLOCATE (m_send%task_char)
     226        4172 :          IF (PRESENT(success)) success = .TRUE.
     227             :       END IF
     228             : 
     229             :       ! =============================
     230             :       ! broadcast
     231             :       ! =============================
     232      521639 :       IF (dest .EQ. bcast_group) THEN
     233        2215 :          IF (para_env%num_pe .GT. 1) THEN
     234           0 :             CALL mp_bcast(m_send%info, MASTER_COMM_ID, para_env%group)
     235           0 :             IF (m_send%info(2) .GT. 0) THEN
     236           0 :                IF (.NOT. act_send_recv) ALLOCATE (m_send%task_int(m_send%info(2)))
     237           0 :                CALL mp_bcast(m_send%task_int, MASTER_COMM_ID, para_env%group)
     238             :             END IF
     239           0 :             IF (m_send%info(3) .GT. 0) THEN
     240           0 :                IF (.NOT. act_send_recv) ALLOCATE (m_send%task_real(m_send%info(3)))
     241           0 :                CALL mp_bcast(m_send%task_real, MASTER_COMM_ID, para_env%group)
     242             :             END IF
     243           0 :             IF (m_send%info(4) .GT. 0) THEN
     244           0 :                IF (.NOT. act_send_recv) ALLOCATE (m_send%task_char(m_send%info(3)))
     245           0 :                CPABORT("")
     246             :                !TODO bcast char CALL mp_bcast(m_send%task_char, MASTER_COMM_ID, para_env%group)
     247             :             END IF
     248             :          END IF
     249             :          ! sender delete arrays
     250        2215 :          IF (act_send_recv) THEN
     251        2215 :             IF (m_send%info(2) .GT. 0) DEALLOCATE (m_send%task_int)
     252        2215 :             IF (m_send%info(3) .GT. 0) DEALLOCATE (m_send%task_real)
     253        2215 :             IF (m_send%info(4) .GT. 0) DEALLOCATE (m_send%task_char)
     254             :          END IF
     255             :       END IF
     256             : 
     257             :       ! =============================
     258             :       ! receiving message
     259             :       ! =============================
     260      521639 :       IF ((act_send_recv .EQV. recv_msg) .AND. dest .NE. bcast_group) THEN
     261      515252 :          flag = .FALSE.
     262      515252 :          tmp_tag = TMC_STATUS_WAIT_FOR_NEW_TASK
     263      515252 :          IF (PRESENT(wait_for_message)) THEN
     264          14 :             dest = mp_any_source
     265          14 :             CALL mp_probe(dest, para_env%group, tmp_tag)
     266             :             flag = .TRUE.
     267             :          ELSE
     268     1539435 :             participant_loop: DO i = 0, para_env%num_pe - 1
     269     1539435 :                IF (i .NE. para_env%mepos) THEN
     270      515210 :                   dest = i
     271      515210 :                   CALL mp_probe(dest, para_env%group, tmp_tag)
     272      515210 :                   IF (dest .EQ. i) THEN
     273             :                      flag = .TRUE.
     274             :                      EXIT participant_loop
     275             :                   END IF
     276             :                END IF
     277             :             END DO participant_loop
     278             :          END IF
     279      515238 :          IF (flag .EQV. .FALSE.) THEN
     280      511080 :             IF (PRESENT(success)) success = .FALSE.
     281      511080 :             DEALLOCATE (m_send)
     282      511080 :             RETURN
     283             :          END IF
     284             : 
     285        4172 :          IF (tmp_tag .EQ. TMC_STAT_SCF_STEP_ENER_RECEIVE) THEN
     286             :             ! CP2K send back SCF step energies without info message
     287           0 :             message_tag = TMC_STAT_SCF_STEP_ENER_RECEIVE
     288           0 :             m_send%info(1) = TMC_STAT_SCF_STEP_ENER_RECEIVE
     289           0 :             m_send%info(2) = 0 ! no integer values
     290           0 :             m_send%info(3) = 1 ! one double values (SCF total energy)
     291           0 :             m_send%info(4) = 0 ! no character values
     292             :          ELSE
     293        4172 :             message_tag = mp_any_tag
     294             :             ! first get message type and sizes
     295        4172 :             CALL mp_recv(m_send%info, dest, message_tag, para_env%group)
     296             :          END IF
     297             :          IF (DEBUG .GE. 1) &
     298             :             WRITE (*, *) "TMC|message: ID: ", para_env%mepos, &
     299             :             " recv element info from ", dest, " of stat ", m_send%info(1), &
     300             :             " with size int/real/char", m_send%info(2:)
     301             :          !-- receive message integer part
     302        4172 :          IF (m_send%info(2) .GT. 0) THEN
     303        6405 :             ALLOCATE (m_send%task_int(m_send%info(2)))
     304        2135 :             CALL mp_recv(m_send%task_int, dest, message_tag, para_env%group)
     305             :          END IF
     306             :          !-- receive message double (floatingpoint) part
     307        4172 :          IF (m_send%info(3) .GT. 0) THEN
     308       12384 :             ALLOCATE (m_send%task_real(m_send%info(3)))
     309        4128 :             CALL mp_recv(m_send%task_real, dest, message_tag, para_env%group)
     310             :          END IF
     311             :          !-- receive message character part
     312        4172 :          IF (m_send%info(4) .GT. 0) THEN
     313           0 :             ALLOCATE (m_send%task_char(m_send%info(4)))
     314           0 :             CPABORT("")
     315             :             !TODO recv characters CALL mp_recv(m_send%task_char, dest, message_tag, para_env%group)
     316             :          END IF
     317             :       END IF
     318             : 
     319             :       ! handling received message
     320       10559 :       IF (act_send_recv .EQV. recv_msg) THEN
     321             :          ! if the element is supposed to be canceled but received message is not canceling receipt do not handle element
     322             :          ! (because element could be already deallocated, and hence a new element would be created -> not necessary)
     323        4172 :          IF (PRESENT(elem_array)) THEN
     324        2065 :             IF (elem_array(dest)%canceled .AND. m_send%info(1) .NE. TMC_CANCELING_RECEIPT) THEN
     325           0 :                msg_type = m_send%info(1)
     326           0 :                IF (m_send%info(2) .GT. 0) DEALLOCATE (m_send%task_int)
     327           0 :                IF (m_send%info(3) .GT. 0) DEALLOCATE (m_send%task_real)
     328           0 :                IF (m_send%info(4) .GT. 0) DEALLOCATE (m_send%task_char)
     329             :                ! to check for further messages
     330           0 :                IF (PRESENT(success)) success = .TRUE.
     331           0 :                DEALLOCATE (m_send)
     332           0 :                RETURN
     333             :             END IF
     334             :          END IF
     335             : 
     336        4172 :          msg_type = m_send%info(1)
     337          14 :          SELECT CASE (m_send%info(1))
     338             :          CASE (TMC_STAT_START_CONF_REQUEST, TMC_CANCELING_MESSAGE, &
     339             :                TMC_CANCELING_RECEIPT, TMC_STATUS_WAIT_FOR_NEW_TASK, &
     340             :                TMC_STATUS_CALCULATING, TMC_STAT_ANALYSIS_RESULT)
     341             :             ! nothing to do here
     342             :          CASE (TMC_STATUS_WORKER_INIT)
     343          14 :             CALL read_worker_init_message(tmc_params, m_send)
     344             :          CASE (TMC_STAT_START_CONF_RESULT, TMC_STAT_INIT_ANALYSIS)
     345          14 :             IF (PRESENT(elem_array)) THEN
     346             :                CALL read_start_conf_message(msg_type, elem_array(dest)%elem, &
     347           0 :                                             result_count, m_send, tmc_params)
     348             :             ELSE
     349             :                CALL read_start_conf_message(msg_type, elem, result_count, m_send, &
     350          28 :                                             tmc_params)
     351             :             END IF
     352             :          CASE (TMC_STAT_APPROX_ENERGY_RESULT)
     353          14 :             CALL read_approx_energy_result(elem_array(dest)%elem, m_send, tmc_params)
     354             :          CASE (TMC_STAT_ENERGY_REQUEST, TMC_STAT_APPROX_ENERGY_REQUEST)
     355        1993 :             CALL read_energy_request_message(elem, m_send, tmc_params)
     356             :          CASE (TMC_STAT_ENERGY_RESULT)
     357        1979 :             IF (PRESENT(elem_array)) &
     358        1979 :                CALL read_energy_result_message(elem_array(dest)%elem, m_send, tmc_params)
     359             :          CASE (TMC_STAT_NMC_REQUEST, TMC_STAT_NMC_BROADCAST, &
     360             :                TMC_STAT_MD_REQUEST, TMC_STAT_MD_BROADCAST)
     361          57 :             CALL read_NMC_request_massage(msg_type, elem, m_send, tmc_params)
     362             :          CASE (TMC_STAT_NMC_RESULT, TMC_STAT_MD_RESULT)
     363          57 :             IF (PRESENT(elem_array)) &
     364          57 :                CALL read_NMC_result_massage(msg_type, elem_array(dest)%elem, m_send, tmc_params)
     365             :          CASE (TMC_STATUS_FAILED, TMC_STATUS_STOP_RECEIPT)
     366             :             ! if task is failed, handle situation in outer routine
     367             :          CASE (TMC_STAT_SCF_STEP_ENER_RECEIVE)
     368           0 :             CALL read_scf_step_ener(elem_array(dest)%elem, m_send)
     369             :          CASE (TMC_STAT_ANALYSIS_REQUEST)
     370           0 :             CALL read_analysis_request_message(elem, m_send, tmc_params)
     371             :          CASE DEFAULT
     372             :             CALL cp_abort(__LOCATION__, &
     373             :                           "try to receive unknown message type "//cp_to_string(msg_type)// &
     374        4172 :                           "from source "//cp_to_string(dest))
     375             :          END SELECT
     376        4172 :          IF (m_send%info(2) .GT. 0) DEALLOCATE (m_send%task_int)
     377        4172 :          IF (m_send%info(3) .GT. 0) DEALLOCATE (m_send%task_real)
     378        4172 :          IF (m_send%info(4) .GT. 0) DEALLOCATE (m_send%task_char)
     379        4172 :          IF (PRESENT(success)) success = .TRUE.
     380             :       END IF
     381             : 
     382             :       ! ATTENTION there is also an short exit (RETURN) after probing for new messages
     383       10559 :       DEALLOCATE (m_send)
     384             :    END SUBROUTINE tmc_message
     385             : 
     386             : ! **************************************************************************************************
     387             : !> \brief set the messege just with an status tag
     388             : !> \param m_send the message structure
     389             : !> \author Mandes 12.2012
     390             : ! **************************************************************************************************
     391             : 
     392         195 :    SUBROUTINE create_status_message(m_send)
     393             :       TYPE(message_send), POINTER                        :: m_send
     394             : 
     395         195 :       CPASSERT(ASSOCIATED(m_send))
     396             : 
     397             :       ! nothing to do, send just the message tag
     398             : 
     399         195 :       CPASSERT(.NOT. ALLOCATED(m_send%task_int))
     400         195 :       CPASSERT(.NOT. ALLOCATED(m_send%task_real))
     401             :       MARK_USED(m_send)
     402             : 
     403         195 :    END SUBROUTINE create_status_message
     404             : 
     405             :    !============================================================================
     406             :    ! message for requesting start configuration
     407             :    !============================================================================
     408             : !! **************************************************************************************************
     409             : !!> \brief the message for sending the atom mass
     410             : !!>        (number of atoms is also tranfered)
     411             : !!>        atom names have to be done separately,
     412             : !!>        because character send only with bcast possible
     413             : !!> \param tmc_parms th send the cell properties
     414             : !!> \param m_send the message structure
     415             : !!> \param error variable to control error logging, stopping,...
     416             : !!>        see module cp_error_handling
     417             : !!> \author Mandes 02.2013
     418             : !! **************************************************************************************************
     419             : !  SUBROUTINE create_atom_mass_message(m_send, atoms)
     420             : !    TYPE(tmc_atom_type), DIMENSION(:), POINTER    :: atoms
     421             : !    TYPE(message_send), POINTER              :: m_send
     422             : !
     423             : !    CHARACTER(LEN=*), PARAMETER :: routineN = 'create_atom_mass_message', &
     424             : !      routineP = moduleN//':'//routineN
     425             : !
     426             : !    INTEGER                                  :: counter, i, &
     427             : !                                                msg_size_real
     428             : !    LOGICAL                                  :: failure
     429             : !
     430             : !    failure = .FALSE.
     431             : !
     432             : !    CPPrecondition(ASSOCIATED(m_send),cp_failure_level,routineP,failure)
     433             : !    CPPrecondition(.NOT.ALLOCATED(m_send%task_int),cp_failure_level,routineP,failure)
     434             : !    CPPrecondition(.NOT.ALLOCATED(m_send%task_real),cp_failure_level,routineP,failure)
     435             : !    CPPrecondition(.NOT.ALLOCATED(m_send%task_char),cp_failure_level,routineP,failure)
     436             : !
     437             : !    counter =1
     438             : !    msg_size_real = 1+SIZE(tmc_params%cell%hmat)+ 1+SIZE(atoms) +1
     439             : !    ALLOCATE(m_send%task_real(msg_size_real))
     440             : !
     441             : !    m_send%task_real(1) = REAL(SIZE(atoms,KIND=dp))
     442             : !    DO i=1, SIZE(atoms)
     443             : !      m_send%task_real(counter+i) = atoms(i)%mass
     444             : !    END DO
     445             : !    counter = counter + 1+INT(m_send%task_real(counter))
     446             : !    m_send%task_real(counter) = REAL(message_end_flag, KIND=dp) !message end
     447             : !    CPPostconditionNoFail(INT(m_send%task_real(msg_size_real)).EQ.message_end_flag,cp_failure_level,routineP)
     448             : !  END SUBROUTINE create_atom_mass_message
     449             : !
     450             : !! **************************************************************************************************
     451             : !!> \brief the message for reading the atom mass
     452             : !!>        (number of atoms is also tranfered)
     453             : !!>        atom names have to be done separately,
     454             : !!>        because character send only with bcast possible
     455             : !!> \param tmc_parms th send the cell properties
     456             : !!> \param m_send the message structure
     457             : !!> \param error variable to control error logging, stopping,...
     458             : !!>        see module cp_error_handling
     459             : !!> \author Mandes 02.2013
     460             : !! **************************************************************************************************
     461             : !  SUBROUTINE read_atom_mass_message(m_send, atoms)
     462             : !    TYPE(tmc_atom_type), DIMENSION(:), &
     463             : !      POINTER                                :: atoms
     464             : !    TYPE(message_send), POINTER              :: m_send
     465             : !
     466             : !    CHARACTER(LEN=*), PARAMETER :: routineN = 'read_atom_mass_message', &
     467             : !      routineP = moduleN//':'//routineN
     468             : !
     469             : !    INTEGER                                  :: counter, i, nr_atoms
     470             : !    LOGICAL                                  :: failure
     471             : !
     472             : !    failure = .FALSE.
     473             : !
     474             : !    CPPrecondition(ASSOCIATED(m_send),cp_failure_level,routineP,failure)
     475             : !    CPPrecondition(.NOT.ALLOCATED(m_send%task_int),cp_failure_level,routineP,failure)
     476             : !    CPPrecondition(ALLOCATED(m_send%task_real),cp_failure_level,routineP,failure)
     477             : !    CPPrecondition(.NOT.ALLOCATED(m_send%task_char),cp_failure_level,routineP,failure)
     478             : !
     479             : !    counter =1
     480             : !    nr_atoms = m_send%task_real(counter)
     481             : !    IF(.NOT.ASSOCIATED(atoms)) CALL allocate_tmc_atom_type(atoms, nr_atoms)
     482             : !    DO i=1, SIZE(atoms)
     483             : !      atoms(i)%mass = m_send%task_real(counter+i)
     484             : !    END DO
     485             : !    counter = counter + 1+INT(m_send%task_real(counter))
     486             : !    CPPostconditionNoFail(INT(m_send%task_real(counter)).EQ.message_end_flag,cp_failure_level,routineP)
     487             : !  END SUBROUTINE read_atom_mass_message
     488             : 
     489             : ! **************************************************************************************************
     490             : !> \brief the message for the initial values (cell size) to the workers
     491             : !> \param tmc_params to send the cell properties
     492             : !> \param m_send the message structure
     493             : !> \author Mandes 07.2013
     494             : ! **************************************************************************************************
     495          28 :    SUBROUTINE create_worker_init_message(tmc_params, m_send)
     496             :       TYPE(tmc_param_type), POINTER                      :: tmc_params
     497             :       TYPE(message_send), POINTER                        :: m_send
     498             : 
     499             :       INTEGER                                            :: counter, msg_size_int, msg_size_real
     500             : 
     501          28 :       CPASSERT(ASSOCIATED(tmc_params))
     502          28 :       CPASSERT(ASSOCIATED(m_send))
     503          28 :       CPASSERT(.NOT. ALLOCATED(m_send%task_int))
     504          28 :       CPASSERT(.NOT. ALLOCATED(m_send%task_real))
     505          28 :       CPASSERT(.NOT. ALLOCATED(m_send%task_char))
     506          28 :       CPASSERT(ASSOCIATED(tmc_params%cell))
     507             : 
     508          28 :       counter = 1
     509          28 :       msg_size_int = 1 + SIZE(tmc_params%cell%perd) + 1 + 1 + 1 + 1
     510          28 :       ALLOCATE (m_send%task_int(msg_size_int))
     511          28 :       m_send%task_int(counter) = SIZE(tmc_params%cell%perd) ! periodicity of the cell
     512          28 :       counter = counter + 1 + m_send%task_int(counter)
     513         224 :       m_send%task_int(2:counter - 1) = tmc_params%cell%perd(:)
     514          28 :       m_send%task_int(counter) = 1
     515          28 :       m_send%task_int(counter + 1) = tmc_params%cell%symmetry_id
     516          28 :       m_send%task_int(counter + 2) = 0
     517          28 :       IF (tmc_params%cell%orthorhombic) m_send%task_int(counter + 2) = 1
     518          28 :       counter = counter + 3
     519          28 :       m_send%task_int(counter) = message_end_flag
     520          28 :       CPASSERT(counter .EQ. SIZE(m_send%task_int))
     521             : 
     522             :       !float array with cell vectors
     523          28 :       msg_size_real = 1 + SIZE(tmc_params%cell%hmat) + 1
     524          28 :       ALLOCATE (m_send%task_real(msg_size_real))
     525          28 :       counter = 1
     526          28 :       m_send%task_real(counter) = SIZE(tmc_params%cell%hmat) ! cell vectors for cell size
     527             :       m_send%task_real(counter + 1:counter + SIZE(tmc_params%cell%hmat)) = &
     528             :          RESHAPE(tmc_params%cell%hmat(:, :), &
     529         280 :                  (/SIZE(tmc_params%cell%hmat)/))
     530          28 :       counter = counter + 1 + INT(m_send%task_real(counter))
     531          28 :       m_send%task_real(counter) = REAL(message_end_flag, KIND=dp) !message end
     532          28 :       CPASSERT(SIZE(m_send%task_real) .EQ. msg_size_real)
     533          28 :       CPASSERT(INT(m_send%task_real(msg_size_real)) .EQ. message_end_flag)
     534          28 :    END SUBROUTINE create_worker_init_message
     535             : 
     536             : ! **************************************************************************************************
     537             : !> \brief the message for the initial values (cell size) to the workers
     538             : !> \param tmc_params to send the cell properties
     539             : !> \param m_send the message structure
     540             : !> \author Mandes 07.2013
     541             : ! **************************************************************************************************
     542          14 :    SUBROUTINE read_worker_init_message(tmc_params, m_send)
     543             :       TYPE(tmc_param_type), POINTER                      :: tmc_params
     544             :       TYPE(message_send), POINTER                        :: m_send
     545             : 
     546             :       INTEGER                                            :: counter
     547             :       LOGICAL                                            :: flag
     548             : 
     549          14 :       CPASSERT(ASSOCIATED(tmc_params))
     550          14 :       CPASSERT(ASSOCIATED(m_send))
     551          14 :       CPASSERT(m_send%info(3) .GE. 4)
     552             : 
     553          14 :       IF (.NOT. ASSOCIATED(tmc_params%cell)) ALLOCATE (tmc_params%cell)
     554          14 :       counter = 1
     555             :       !int array
     556          14 :       flag = INT(m_send%task_int(1)) .EQ. SIZE(tmc_params%cell%perd)
     557          14 :       CPASSERT(flag)
     558          14 :       counter = 1 + m_send%task_int(1) + 1
     559         112 :       tmc_params%cell%perd = m_send%task_int(2:counter - 1)
     560          14 :       tmc_params%cell%symmetry_id = m_send%task_int(counter + 1)
     561          14 :       tmc_params%cell%orthorhombic = .FALSE.
     562          14 :       IF (m_send%task_int(counter + 2) .EQ. 1) tmc_params%cell%orthorhombic = .TRUE.
     563          14 :       counter = counter + 3
     564          14 :       CPASSERT(counter .EQ. m_send%info(2))
     565          14 :       CPASSERT(m_send%task_int(counter) .EQ. message_end_flag)
     566             : 
     567             :       !float array with cell vectors
     568          14 :       counter = 1
     569          14 :       flag = INT(m_send%task_real(counter)) .EQ. SIZE(tmc_params%cell%hmat)
     570          14 :       CPASSERT(flag)
     571             :       tmc_params%cell%hmat = &
     572             :          RESHAPE(m_send%task_real(counter + 1:counter + &
     573         182 :                                   SIZE(tmc_params%cell%hmat)), (/3, 3/))
     574          14 :       counter = counter + 1 + INT(m_send%task_real(counter))
     575             : 
     576          14 :       CPASSERT(counter .EQ. m_send%info(3))
     577          14 :       CPASSERT(INT(m_send%task_real(m_send%info(3))) .EQ. message_end_flag)
     578             : 
     579          14 :    END SUBROUTINE read_worker_init_message
     580             : 
     581             : ! **************************************************************************************************
     582             : !> \brief the message for sending back the initial configuration
     583             : !> \param msg_type the status tag
     584             : !> \param elem the initial tree element with initial coordinates and energy
     585             : !>        (using the approximated potential)
     586             : !> \param result_count ...
     587             : !> \param tmc_params to send the cell properties
     588             : !> \param m_send the message structure
     589             : !> \author Mandes 12.2012
     590             : ! **************************************************************************************************
     591          14 :    SUBROUTINE create_start_conf_message(msg_type, elem, result_count, &
     592             :                                         tmc_params, m_send)
     593             :       INTEGER                                            :: msg_type
     594             :       TYPE(tree_type), POINTER                           :: elem
     595             :       INTEGER, DIMENSION(:), OPTIONAL, POINTER           :: result_count
     596             :       TYPE(tmc_param_type), POINTER                      :: tmc_params
     597             :       TYPE(message_send), POINTER                        :: m_send
     598             : 
     599             :       INTEGER                                            :: counter, i, msg_size_int, msg_size_real
     600             : 
     601          14 :       CPASSERT(ASSOCIATED(m_send))
     602          14 :       CPASSERT(ASSOCIATED(elem))
     603          14 :       CPASSERT(ASSOCIATED(tmc_params))
     604          14 :       CPASSERT(ASSOCIATED(tmc_params%atoms))
     605          14 :       CPASSERT(.NOT. ALLOCATED(m_send%task_int))
     606          14 :       CPASSERT(.NOT. ALLOCATED(m_send%task_real))
     607          14 :       CPASSERT(.NOT. ALLOCATED(m_send%task_char))
     608             : 
     609          14 :       counter = 1
     610          14 :       msg_size_int = 1 + SIZE(tmc_params%cell%perd) + 1 + 1 + 1 + 1 + SIZE(elem%mol) + 1
     611          14 :       IF (msg_type .EQ. TMC_STAT_INIT_ANALYSIS) THEN
     612           0 :          CPASSERT(PRESENT(result_count))
     613           0 :          CPASSERT(ASSOCIATED(result_count))
     614           0 :          msg_size_int = msg_size_int + 1 + SIZE(result_count(1:))
     615             :       END IF
     616          42 :       ALLOCATE (m_send%task_int(msg_size_int))
     617          14 :       m_send%task_int(counter) = SIZE(tmc_params%cell%perd) ! periodicity of the cell
     618          14 :       counter = counter + 1 + m_send%task_int(counter)
     619         112 :       m_send%task_int(2:counter - 1) = tmc_params%cell%perd(:)
     620          14 :       m_send%task_int(counter) = 1
     621          14 :       m_send%task_int(counter + 1) = tmc_params%cell%symmetry_id
     622          14 :       m_send%task_int(counter + 2) = 0
     623          14 :       IF (tmc_params%cell%orthorhombic) m_send%task_int(counter + 2) = 1
     624          14 :       counter = counter + 3
     625          14 :       m_send%task_int(counter) = SIZE(elem%mol)
     626        3788 :       m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = elem%mol(:)
     627          14 :       counter = counter + 1 + m_send%task_int(counter)
     628          14 :       IF (msg_type .EQ. TMC_STAT_INIT_ANALYSIS) THEN
     629           0 :          m_send%task_int(counter) = SIZE(result_count(1:))
     630             :          m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = &
     631           0 :             result_count(1:)
     632           0 :          counter = counter + 1 + m_send%task_int(counter)
     633             :       END IF
     634          14 :       m_send%task_int(counter) = message_end_flag
     635          14 :       CPASSERT(counter .EQ. SIZE(m_send%task_int))
     636             : 
     637          14 :       counter = 0
     638             :       !float array with pos, cell vectors, atom_mass
     639             :       msg_size_real = 1 + SIZE(elem%pos) + 1 + SIZE(tmc_params%cell%hmat) &
     640          14 :                       + 1 + SIZE(tmc_params%atoms) + 1
     641          42 :       ALLOCATE (m_send%task_real(msg_size_real))
     642          14 :       m_send%task_real(1) = REAL(SIZE(elem%pos), KIND=dp) ! positions
     643          14 :       counter = 2 + INT(m_send%task_real(1))
     644       11308 :       m_send%task_real(2:counter - 1) = elem%pos
     645          14 :       m_send%task_real(counter) = SIZE(tmc_params%cell%hmat) ! cell vectors for cell size
     646             :       m_send%task_real(counter + 1:counter + SIZE(tmc_params%cell%hmat)) = &
     647             :          RESHAPE(tmc_params%cell%hmat(:, :), &
     648         140 :                  (/SIZE(tmc_params%cell%hmat)/))
     649          14 :       counter = counter + 1 + INT(m_send%task_real(counter))
     650          14 :       m_send%task_real(counter) = SIZE(tmc_params%atoms) ! atom mass
     651        1894 :       DO i = 1, SIZE(tmc_params%atoms)
     652        1894 :          m_send%task_real(counter + i) = tmc_params%atoms(i)%mass
     653             :       END DO
     654          14 :       counter = counter + 1 + INT(m_send%task_real(counter))
     655          14 :       m_send%task_real(counter) = REAL(message_end_flag, KIND=dp) !message end
     656          14 :       CPASSERT(SIZE(m_send%task_real) .EQ. msg_size_real)
     657          14 :       CPASSERT(INT(m_send%task_real(msg_size_real)) .EQ. message_end_flag)
     658             : 
     659          14 :    END SUBROUTINE create_start_conf_message
     660             : 
     661             : ! **************************************************************************************************
     662             : !> \brief the message for sending back the initial configuration
     663             : !> \param msg_type the status tag
     664             : !> \param elem the initial tree element with initial coordinates and energy
     665             : !>        (using the approximated potential)
     666             : !> \param result_count ...
     667             : !> \param m_send the message structure
     668             : !> \param tmc_params the param struct with necessary values for allocation
     669             : !> \author Mandes 12.2012
     670             : ! **************************************************************************************************
     671          14 :    SUBROUTINE read_start_conf_message(msg_type, elem, result_count, m_send, &
     672             :                                       tmc_params)
     673             :       INTEGER                                            :: msg_type
     674             :       TYPE(tree_type), POINTER                           :: elem
     675             :       INTEGER, DIMENSION(:), OPTIONAL, POINTER           :: result_count
     676             :       TYPE(message_send), POINTER                        :: m_send
     677             :       TYPE(tmc_param_type), POINTER                      :: tmc_params
     678             : 
     679             :       INTEGER                                            :: counter, i
     680             :       LOGICAL                                            :: flag
     681             : 
     682          14 :       CPASSERT(ASSOCIATED(tmc_params))
     683          14 :       CPASSERT(.NOT. ASSOCIATED(tmc_params%atoms))
     684          14 :       CPASSERT(ASSOCIATED(m_send))
     685          14 :       CPASSERT(.NOT. ASSOCIATED(elem))
     686          14 :       CPASSERT(m_send%info(3) .GE. 4)
     687             : 
     688          14 :       IF (.NOT. ASSOCIATED(tmc_params%cell)) ALLOCATE (tmc_params%cell)
     689             :       CALL allocate_new_sub_tree_node(tmc_params=tmc_params, next_el=elem, &
     690          14 :                                       nr_dim=NINT(m_send%task_real(1)))
     691          14 :       counter = 1
     692             :       !int array
     693          14 :       flag = INT(m_send%task_int(1)) .EQ. SIZE(tmc_params%cell%perd)
     694          14 :       CPASSERT(flag)
     695          14 :       counter = 1 + m_send%task_int(1) + 1
     696          98 :       tmc_params%cell%perd = m_send%task_int(2:counter - 1)
     697          14 :       tmc_params%cell%symmetry_id = m_send%task_int(counter + 1)
     698          14 :       tmc_params%cell%orthorhombic = .FALSE.
     699          14 :       IF (m_send%task_int(counter + 2) .EQ. 1) tmc_params%cell%orthorhombic = .TRUE.
     700          14 :       counter = counter + 3
     701        3774 :       elem%mol(:) = m_send%task_int(counter + 1:counter + m_send%task_int(counter))
     702          14 :       counter = counter + 1 + m_send%task_int(counter)
     703          14 :       IF (msg_type .EQ. TMC_STAT_INIT_ANALYSIS) THEN
     704           0 :          CPASSERT(PRESENT(result_count))
     705           0 :          CPASSERT(.NOT. ASSOCIATED(result_count))
     706           0 :          ALLOCATE (result_count(m_send%task_int(counter)))
     707           0 :          result_count(:) = m_send%task_int(counter + 1:counter + m_send%task_int(counter))
     708           0 :          counter = counter + 1 + m_send%task_int(counter)
     709             :       END IF
     710          14 :       CPASSERT(counter .EQ. m_send%info(2))
     711          14 :       CPASSERT(m_send%task_int(counter) .EQ. message_end_flag)
     712             : 
     713          14 :       counter = 0
     714             :       !float array with pos, cell vectors, atom_mass
     715          14 :       counter = 2 + INT(m_send%task_real(1))
     716       11294 :       elem%pos = m_send%task_real(2:counter - 1)
     717          14 :       flag = INT(m_send%task_real(counter)) .EQ. SIZE(tmc_params%cell%hmat)
     718          14 :       CPASSERT(flag)
     719             :       tmc_params%cell%hmat = &
     720             :          RESHAPE(m_send%task_real(counter + 1:counter + &
     721         182 :                                   SIZE(tmc_params%cell%hmat)), (/3, 3/))
     722          14 :       counter = counter + 1 + INT(m_send%task_real(counter))
     723             : 
     724             :       CALL allocate_tmc_atom_type(atoms=tmc_params%atoms, &
     725          14 :                                   nr_atoms=INT(m_send%task_real(counter)))
     726        1894 :       DO i = 1, SIZE(tmc_params%atoms)
     727        1894 :          tmc_params%atoms(i)%mass = m_send%task_real(counter + i)
     728             :       END DO
     729          14 :       counter = counter + 1 + INT(m_send%task_real(counter))
     730             : 
     731          14 :       CPASSERT(counter .EQ. m_send%info(3))
     732          14 :       CPASSERT(INT(m_send%task_real(m_send%info(3))) .EQ. message_end_flag)
     733             : 
     734          14 :    END SUBROUTINE read_start_conf_message
     735             : 
     736             :    !============================================================================
     737             :    ! Energy messages
     738             :    !============================================================================
     739             : ! **************************************************************************************************
     740             : !> \brief creating message for requesting exact energy of new configuration
     741             : !> \param elem tree element with new coordinates
     742             : !> \param m_send the message structure
     743             : !> \param tmc_params stuct with parameters (global settings)
     744             : !> \author Mandes 12.2012
     745             : ! **************************************************************************************************
     746        3986 :    SUBROUTINE create_energy_request_message(elem, m_send, &
     747             :                                             tmc_params)
     748             :       TYPE(tree_type), POINTER                           :: elem
     749             :       TYPE(message_send), POINTER                        :: m_send
     750             :       TYPE(tmc_param_type), POINTER                      :: tmc_params
     751             : 
     752             :       INTEGER                                            :: counter, msg_size_int, msg_size_real
     753             : 
     754        3986 :       CPASSERT(ASSOCIATED(m_send))
     755        3986 :       CPASSERT(.NOT. ALLOCATED(m_send%task_int))
     756        3986 :       CPASSERT(.NOT. ALLOCATED(m_send%task_real))
     757        3986 :       CPASSERT(ASSOCIATED(elem))
     758        3986 :       CPASSERT(ASSOCIATED(tmc_params))
     759             : 
     760        3986 :       counter = 0
     761             :       !first integer array
     762        3986 :       msg_size_int = 1 + 1 + 1 + 1 + 1 ! 1+SIZE(elem%sub_tree_nr) +1+SIZE(elem%nr)
     763        3986 :       ALLOCATE (m_send%task_int(msg_size_int))
     764        3986 :       counter = 1
     765        3986 :       m_send%task_int(counter) = 1 !SIZE(elem%sub_tree_nr)
     766        7972 :       m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = elem%sub_tree_nr
     767        3986 :       counter = counter + 1 + m_send%task_int(counter)
     768        3986 :       m_send%task_int(counter) = 1 !SIZE(elem%nr)
     769        7972 :       m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = elem%nr
     770        3986 :       counter = counter + 1 + m_send%task_int(counter)
     771        3986 :       m_send%task_int(counter) = message_end_flag
     772        3986 :       CPASSERT(SIZE(m_send%task_int) .EQ. msg_size_int)
     773        3986 :       CPASSERT(m_send%task_int(msg_size_int) .EQ. message_end_flag)
     774             : 
     775             :       !then float array with pos
     776        3986 :       msg_size_real = 1 + SIZE(elem%pos) + 1
     777        3986 :       IF (tmc_params%pressure .GE. 0.0_dp) msg_size_real = msg_size_real + 1 + SIZE(elem%box_scale(:))
     778       11958 :       ALLOCATE (m_send%task_real(msg_size_real))
     779        3986 :       m_send%task_real(1) = SIZE(elem%pos)
     780        3986 :       counter = 2 + INT(m_send%task_real(1))
     781      819556 :       m_send%task_real(2:counter - 1) = elem%pos
     782        3986 :       IF (tmc_params%pressure .GE. 0.0_dp) THEN
     783        1352 :          m_send%task_real(counter) = SIZE(elem%box_scale)
     784       10816 :          m_send%task_real(counter + 1:counter + INT(m_send%task_real(counter))) = elem%box_scale(:)
     785        1352 :          counter = counter + 1 + INT(m_send%task_real(counter))
     786             :       END IF
     787        3986 :       m_send%task_real(counter) = REAL(message_end_flag, KIND=dp) !message end
     788             : 
     789        3986 :       CPASSERT(SIZE(m_send%task_real) .EQ. msg_size_real)
     790        3986 :       CPASSERT(INT(m_send%task_real(msg_size_real)) .EQ. message_end_flag)
     791        3986 :    END SUBROUTINE create_energy_request_message
     792             : 
     793             : ! **************************************************************************************************
     794             : !> \brief reading message for requesting exact energy of new configuration
     795             : !> \param elem tree element with new coordinates
     796             : !> \param m_send the message structure
     797             : !> \param tmc_params stuct with parameters (global settings)
     798             : !> \author Mandes 12.2012
     799             : ! **************************************************************************************************
     800        1993 :    SUBROUTINE read_energy_request_message(elem, m_send, tmc_params)
     801             :       TYPE(tree_type), POINTER                           :: elem
     802             :       TYPE(message_send), POINTER                        :: m_send
     803             :       TYPE(tmc_param_type), POINTER                      :: tmc_params
     804             : 
     805             :       INTEGER                                            :: counter
     806             : 
     807        1993 :       CPASSERT(ASSOCIATED(m_send))
     808        1993 :       CPASSERT(m_send%info(3) .GT. 0)
     809        1993 :       CPASSERT(ASSOCIATED(tmc_params))
     810        1993 :       CPASSERT(.NOT. ASSOCIATED(elem))
     811             : 
     812             :       ! initialize the new sub tree element
     813        1993 :       IF (.NOT. ASSOCIATED(elem)) THEN
     814             :          CALL allocate_new_sub_tree_node(next_el=elem, nr_dim=NINT(m_send%task_real(1)), &
     815        1993 :                                          tmc_params=tmc_params)
     816             :       END IF
     817             :       ! read the integer values
     818        1993 :       CPASSERT(m_send%info(2) .GT. 0)
     819        1993 :       counter = 1
     820        1993 :       elem%sub_tree_nr = m_send%task_int(counter + 1)
     821        1993 :       counter = counter + 1 + m_send%task_int(counter)
     822        1993 :       elem%nr = m_send%task_int(counter + 1)
     823        1993 :       counter = counter + 1 + m_send%task_int(counter)
     824        1993 :       CPASSERT(m_send%task_int(counter) .EQ. message_end_flag)
     825             : 
     826             :       !float array with pos
     827        1993 :       counter = 0
     828        1993 :       counter = 1 + NINT(m_send%task_real(1))
     829      407785 :       elem%pos = m_send%task_real(2:counter)
     830        1993 :       counter = counter + 1
     831        1993 :       IF (tmc_params%pressure .GE. 0.0_dp) THEN
     832        4732 :          elem%box_scale(:) = m_send%task_real(counter + 1:counter + INT(m_send%task_real(counter)))
     833         676 :          counter = counter + 1 + INT(m_send%task_real(counter))
     834             :       END IF
     835             : 
     836        1993 :       CPASSERT(counter .EQ. m_send%info(3))
     837        1993 :       CPASSERT(INT(m_send%task_real(m_send%info(3))) .EQ. message_end_flag)
     838        1993 :    END SUBROUTINE read_energy_request_message
     839             : 
     840             : ! **************************************************************************************************
     841             : !> \brief creating message for sending back the exact energy of new conf
     842             : !> \param elem tree element  with calculated energy
     843             : !> \param m_send the message structure
     844             : !> \param tmc_params stuct with parameters (global settings)
     845             : !> \author Mandes 12.2012
     846             : ! **************************************************************************************************
     847        1979 :    SUBROUTINE create_energy_result_message(elem, m_send, tmc_params)
     848             :       TYPE(tree_type), POINTER                           :: elem
     849             :       TYPE(message_send), POINTER                        :: m_send
     850             :       TYPE(tmc_param_type), POINTER                      :: tmc_params
     851             : 
     852             :       INTEGER                                            :: counter, msg_size_int, msg_size_real
     853             : 
     854        1979 :       CPASSERT(ASSOCIATED(m_send))
     855        1979 :       CPASSERT(.NOT. ALLOCATED(m_send%task_int))
     856        1979 :       CPASSERT(.NOT. ALLOCATED(m_send%task_real))
     857        1979 :       CPASSERT(ASSOCIATED(elem))
     858        1979 :       CPASSERT(ASSOCIATED(tmc_params))
     859             : 
     860        1979 :       counter = 0
     861             :       !first integer array
     862        1979 :       msg_size_int = 0
     863             :       ! for checking the tree element mapping, send back the tree numbers
     864             :       IF (DEBUG .GT. 0) THEN
     865             :          msg_size_int = 1 + 1 + 1 + 1 + 1 ! 1+SIZE(elem%sub_tree_nr) +1+SIZE(elem%nr)
     866             :          ALLOCATE (m_send%task_int(msg_size_int))
     867             :          counter = 1
     868             :          m_send%task_int(counter) = 1 !SIZE(elem%sub_tree_nr)
     869             :          m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = elem%sub_tree_nr
     870             :          counter = counter + 1 + m_send%task_int(counter)
     871             :          m_send%task_int(counter) = 1 !SIZE(elem%nr)
     872             :          m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = elem%nr
     873             :          counter = counter + m_send%task_int(counter) + 1
     874             :          m_send%task_int(counter) = message_end_flag !message end
     875             :       END IF
     876             : 
     877             :       !then float array with energy of exact potential
     878        1979 :       msg_size_real = 1 + 1 + 1
     879        1979 :       IF (tmc_params%print_forces) msg_size_real = msg_size_real + 1 + SIZE(elem%frc)
     880        1979 :       IF (tmc_params%print_dipole) msg_size_real = msg_size_real + 1 + SIZE(elem%dipole)
     881             : 
     882        5937 :       ALLOCATE (m_send%task_real(msg_size_real))
     883        1979 :       m_send%task_real(1) = 1
     884        1979 :       m_send%task_real(2) = elem%potential
     885        1979 :       counter = 3
     886        1979 :       IF (tmc_params%print_forces) THEN
     887         598 :          m_send%task_real(counter) = SIZE(elem%frc)
     888       75946 :          m_send%task_real(counter + 1:counter + NINT(m_send%task_real(counter))) = elem%frc
     889         598 :          counter = counter + NINT(m_send%task_real(counter)) + 1
     890             :       END IF
     891        1979 :       IF (tmc_params%print_dipole) THEN
     892           0 :          m_send%task_real(counter) = SIZE(elem%dipole)
     893           0 :          m_send%task_real(counter + 1:counter + NINT(m_send%task_real(counter))) = elem%dipole
     894           0 :          counter = counter + NINT(m_send%task_real(counter)) + 1
     895             :       END IF
     896             : 
     897        1979 :       m_send%task_real(counter) = REAL(message_end_flag, KIND=dp) !message end
     898             : 
     899        1979 :       CPASSERT(SIZE(m_send%task_real) .EQ. msg_size_real)
     900        1979 :       CPASSERT(INT(m_send%task_real(msg_size_real)) .EQ. message_end_flag)
     901        1979 :    END SUBROUTINE create_energy_result_message
     902             : 
     903             : ! **************************************************************************************************
     904             : !> \brief reading message for sending back the exact energy of new conf
     905             : !> \param elem tree element for storing new energy
     906             : !> \param m_send the message structure
     907             : !> \param tmc_params stuct with parameters (global settings)
     908             : !> \author Mandes 12.2012
     909             : ! **************************************************************************************************
     910        1979 :    SUBROUTINE read_energy_result_message(elem, m_send, tmc_params)
     911             :       TYPE(tree_type), POINTER                           :: elem
     912             :       TYPE(message_send), POINTER                        :: m_send
     913             :       TYPE(tmc_param_type), POINTER                      :: tmc_params
     914             : 
     915             :       INTEGER                                            :: counter
     916             : 
     917        1979 :       CPASSERT(ASSOCIATED(elem))
     918        1979 :       CPASSERT(ASSOCIATED(m_send))
     919        1979 :       CPASSERT(m_send%info(3) .GT. 0)
     920        1979 :       CPASSERT(ASSOCIATED(tmc_params))
     921             : 
     922             :       ! read the integer values
     923             :       ! for checking the tree element mapping, check the tree numbers
     924             :       IF (DEBUG .GT. 0) THEN
     925             :          counter = 1
     926             :          IF (elem%sub_tree_nr .NE. m_send%task_int(counter + 1) .OR. &
     927             :              elem%nr .NE. m_send%task_int(counter + 3)) THEN
     928             :             WRITE (*, *) "ERROR: read_energy_result: master got energy result of subtree elem ", &
     929             :                m_send%task_int(counter + 1), m_send%task_int(counter + 3), &
     930             :                " but expect result of subtree elem", elem%sub_tree_nr, elem%nr
     931             :             CPABORT("read_energy_result: got energy result from unexpected tree element.")
     932             :          END IF
     933             :       ELSE
     934        1979 :          CPASSERT(m_send%info(2) .EQ. 0)
     935             :       END IF
     936             : 
     937             :       !then float array with energy of exact potential
     938        1979 :       elem%potential = m_send%task_real(2)
     939        1979 :       counter = 3
     940        1979 :       IF (tmc_params%print_forces) THEN
     941       75946 :          elem%frc(:) = m_send%task_real((counter + 1):(counter + NINT(m_send%task_real(counter))))
     942         598 :          counter = counter + 1 + NINT(m_send%task_real(counter))
     943             :       END IF
     944        1979 :       IF (tmc_params%print_dipole) THEN
     945           0 :          elem%dipole(:) = m_send%task_real((counter + 1):(counter + NINT(m_send%task_real(counter))))
     946           0 :          counter = counter + 1 + NINT(m_send%task_real(counter))
     947             :       END IF
     948             : 
     949        1979 :       CPASSERT(counter .EQ. m_send%info(3))
     950        1979 :       CPASSERT(INT(m_send%task_real(m_send%info(3))) .EQ. message_end_flag)
     951        1979 :    END SUBROUTINE read_energy_result_message
     952             : 
     953             : ! **************************************************************************************************
     954             : !> \brief create message for sending back the approximate energy of new conf
     955             : !> \param elem tree element with calculated approx energy
     956             : !> \param m_send the message structure
     957             : !> \param tmc_params stuct with parameters (global settings)
     958             : !> \author Mandes 12.2012
     959             : ! **************************************************************************************************
     960          14 :    SUBROUTINE create_approx_energy_result_message(elem, m_send, &
     961             :                                                   tmc_params)
     962             :       TYPE(tree_type), POINTER                           :: elem
     963             :       TYPE(message_send), POINTER                        :: m_send
     964             :       TYPE(tmc_param_type), POINTER                      :: tmc_params
     965             : 
     966             :       INTEGER                                            :: counter, msg_size_real
     967             : 
     968          14 :       CPASSERT(ASSOCIATED(m_send))
     969          14 :       CPASSERT(.NOT. ALLOCATED(m_send%task_int))
     970          14 :       CPASSERT(.NOT. ALLOCATED(m_send%task_real))
     971          14 :       CPASSERT(ASSOCIATED(elem))
     972          14 :       CPASSERT(ASSOCIATED(tmc_params))
     973             : 
     974          14 :       counter = 0
     975             : 
     976             :       !then float array with energy of exact potential
     977          14 :       msg_size_real = 1 + 1 + 1
     978          14 :       IF (tmc_params%pressure .GE. 0.0_dp) msg_size_real = msg_size_real + 1 + SIZE(elem%box_scale(:))
     979             : 
     980          42 :       ALLOCATE (m_send%task_real(msg_size_real))
     981          14 :       m_send%task_real(1) = 1
     982          14 :       m_send%task_real(2) = elem%e_pot_approx
     983          14 :       counter = 3
     984             :       ! the box size for NpT
     985          14 :       IF (tmc_params%pressure .GE. 0.0_dp) THEN
     986          12 :          m_send%task_real(counter) = SIZE(elem%box_scale)
     987          96 :          m_send%task_real(counter + 1:counter + INT(m_send%task_real(counter))) = elem%box_scale(:)
     988          12 :          counter = counter + 1 + INT(m_send%task_real(counter))
     989             :       END IF
     990          14 :       m_send%task_real(counter) = REAL(message_end_flag, KIND=dp) !message end
     991             : 
     992          14 :       CPASSERT(SIZE(m_send%task_real) .EQ. msg_size_real)
     993          14 :       CPASSERT(INT(m_send%task_real(msg_size_real)) .EQ. message_end_flag)
     994          14 :    END SUBROUTINE create_approx_energy_result_message
     995             : 
     996             : ! **************************************************************************************************
     997             : !> \brief reading message for sending back the exact energy of new conf
     998             : !> \param elem tree element for storing new energy
     999             : !> \param m_send the message structure
    1000             : !> \param tmc_params the param struct with necessary parameters
    1001             : !> \author Mandes 12.2012
    1002             : ! **************************************************************************************************
    1003          14 :    SUBROUTINE read_approx_energy_result(elem, m_send, tmc_params)
    1004             :       TYPE(tree_type), POINTER                           :: elem
    1005             :       TYPE(message_send), POINTER                        :: m_send
    1006             :       TYPE(tmc_param_type), POINTER                      :: tmc_params
    1007             : 
    1008             :       INTEGER                                            :: counter
    1009             : 
    1010          14 :       CPASSERT(ASSOCIATED(elem))
    1011          14 :       CPASSERT(ASSOCIATED(m_send))
    1012          14 :       CPASSERT(m_send%info(2) .EQ. 0 .AND. m_send%info(3) .GT. 0)
    1013          14 :       CPASSERT(ASSOCIATED(tmc_params))
    1014             : 
    1015             :       !then float array with energy of exact potential
    1016          14 :       elem%e_pot_approx = m_send%task_real(2)
    1017          14 :       counter = 3
    1018          14 :       IF (tmc_params%pressure .GE. 0.0_dp) THEN
    1019          96 :          elem%box_scale(:) = m_send%task_real(counter + 1:counter + INT(m_send%task_real(counter)))
    1020          12 :          counter = counter + 1 + INT(m_send%task_real(counter))
    1021             :       END IF
    1022             : 
    1023          14 :       CPASSERT(counter .EQ. m_send%info(3))
    1024          14 :       CPASSERT(INT(m_send%task_real(m_send%info(3))) .EQ. message_end_flag)
    1025          14 :    END SUBROUTINE read_approx_energy_result
    1026             : 
    1027             :    !============================================================================
    1028             :    ! Nested Monte Carlo request messages
    1029             :    !============================================================================
    1030             : ! **************************************************************************************************
    1031             : !> \brief creating message for Nested Monte Carlo sampling of new configuration
    1032             : !> \param msg_type the status tag
    1033             : !> \param elem tree element  with calculated energy
    1034             : !> \param m_send the message structure
    1035             : !> \param tmc_params stuct with parameters (global settings)
    1036             : !> \author Mandes 12.2012
    1037             : ! **************************************************************************************************
    1038         114 :    SUBROUTINE create_NMC_request_massage(msg_type, elem, m_send, &
    1039             :                                          tmc_params)
    1040             :       INTEGER                                            :: msg_type
    1041             :       TYPE(tree_type), POINTER                           :: elem
    1042             :       TYPE(message_send), POINTER                        :: m_send
    1043             :       TYPE(tmc_param_type), POINTER                      :: tmc_params
    1044             : 
    1045             :       INTEGER                                            :: counter, msg_size_int, msg_size_real
    1046             : 
    1047         114 :       CPASSERT(ASSOCIATED(m_send))
    1048         114 :       CPASSERT(ASSOCIATED(elem))
    1049         114 :       CPASSERT(.NOT. ALLOCATED(m_send%task_int))
    1050         114 :       CPASSERT(.NOT. ALLOCATED(m_send%task_real))
    1051         114 :       CPASSERT(ASSOCIATED(tmc_params))
    1052             : 
    1053         114 :       counter = 0
    1054             :       !first integer array with element status,mol_info, move type, sub tree, element nr, temp index
    1055         114 :       msg_size_int = 1 + SIZE(elem%elem_stat) + 1 + SIZE(elem%mol) + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1
    1056             : 
    1057         342 :       ALLOCATE (m_send%task_int(msg_size_int))
    1058             :       ! element status
    1059         114 :       m_send%task_int(1) = SIZE(elem%elem_stat)
    1060         114 :       counter = 2 + m_send%task_int(1)
    1061      197106 :       m_send%task_int(2:counter - 1) = elem%elem_stat
    1062         114 :       m_send%task_int(counter) = SIZE(elem%mol)
    1063       65778 :       m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = elem%mol(:)
    1064         114 :       counter = counter + 1 + m_send%task_int(counter)
    1065             :       ! element move type
    1066         114 :       m_send%task_int(counter) = 1
    1067         114 :       m_send%task_int(counter + 1) = elem%move_type
    1068         114 :       counter = counter + 2
    1069         114 :       m_send%task_int(counter) = 1
    1070         114 :       m_send%task_int(counter + 1) = elem%nr
    1071         114 :       counter = counter + 2
    1072         114 :       m_send%task_int(counter) = 1
    1073         114 :       m_send%task_int(counter + 1) = elem%sub_tree_nr
    1074         114 :       counter = counter + 2
    1075         114 :       m_send%task_int(counter) = 1
    1076         114 :       m_send%task_int(counter + 1) = elem%temp_created
    1077         114 :       m_send%task_int(counter + 2) = message_end_flag !message end
    1078             : 
    1079         114 :       counter = 0
    1080             :       !then float array with pos, (vel), random number seed, subbox_center
    1081         114 :       msg_size_real = 1 + SIZE(elem%pos) + 1 + SIZE(elem%rng_seed) + 1 + SIZE(elem%subbox_center(:)) + 1
    1082         114 :       IF (msg_type .EQ. TMC_STAT_MD_REQUEST .OR. msg_type .EQ. TMC_STAT_MD_BROADCAST) &
    1083           0 :          msg_size_real = msg_size_real + 1 + SIZE(elem%vel) ! the velocities
    1084         114 :       IF (tmc_params%pressure .GE. 0.0_dp) msg_size_real = msg_size_real + 1 + SIZE(elem%box_scale(:)) ! box size for NpT
    1085             : 
    1086         342 :       ALLOCATE (m_send%task_real(msg_size_real))
    1087         114 :       m_send%task_real(1) = SIZE(elem%pos)
    1088         114 :       counter = 2 + INT(m_send%task_real(1))
    1089      197106 :       m_send%task_real(2:counter - 1) = elem%pos
    1090         114 :       IF (msg_type .EQ. TMC_STAT_MD_REQUEST .OR. msg_type .EQ. TMC_STAT_MD_BROADCAST) THEN
    1091           0 :          m_send%task_real(counter) = SIZE(elem%vel)
    1092           0 :          m_send%task_real(counter + 1:counter + NINT(m_send%task_real(counter))) = elem%vel
    1093           0 :          counter = counter + 1 + NINT(m_send%task_real(counter))
    1094             :       END IF
    1095             :       ! rng seed
    1096         114 :       m_send%task_real(counter) = SIZE(elem%rng_seed)
    1097        2166 :       m_send%task_real(counter + 1:counter + SIZE(elem%rng_seed)) = RESHAPE(elem%rng_seed(:, :, :), (/SIZE(elem%rng_seed)/))
    1098         114 :       counter = counter + NINT(m_send%task_real(counter)) + 1
    1099             :       ! sub box center
    1100         114 :       m_send%task_real(counter) = SIZE(elem%subbox_center(:))
    1101         798 :       m_send%task_real(counter + 1:counter + SIZE(elem%subbox_center)) = elem%subbox_center(:)
    1102         114 :       counter = counter + 1 + NINT(m_send%task_real(counter))
    1103             :       ! the box size for NpT
    1104         114 :       IF (tmc_params%pressure .GE. 0.0_dp) THEN
    1105          68 :          m_send%task_real(counter) = SIZE(elem%box_scale)
    1106         476 :          m_send%task_real(counter + 1:counter + INT(m_send%task_real(counter))) = elem%box_scale(:)
    1107          68 :          counter = counter + 1 + INT(m_send%task_real(counter))
    1108             :       END IF
    1109         114 :       m_send%task_real(counter) = message_end_flag !message end
    1110             : 
    1111         114 :       CPASSERT(SIZE(m_send%task_int) .EQ. msg_size_int)
    1112         114 :       CPASSERT(SIZE(m_send%task_real) .EQ. msg_size_real)
    1113         114 :       CPASSERT(m_send%task_int(msg_size_int) .EQ. message_end_flag)
    1114         114 :       CPASSERT(INT(m_send%task_real(msg_size_real)) .EQ. message_end_flag)
    1115         114 :    END SUBROUTINE create_NMC_request_massage
    1116             : 
    1117             : ! **************************************************************************************************
    1118             : !> \brief reading message for Nested Monte Carlo sampling of new configuration
    1119             : !> \param msg_type the status tag
    1120             : !> \param elem tree element with new coordinates
    1121             : !> \param m_send the message structure
    1122             : !> \param tmc_params stuct with parameters (global settings)
    1123             : !> \author Mandes 12.2012
    1124             : ! **************************************************************************************************
    1125          57 :    SUBROUTINE read_NMC_request_massage(msg_type, elem, m_send, &
    1126             :                                        tmc_params)
    1127             :       INTEGER                                            :: msg_type
    1128             :       TYPE(tree_type), POINTER                           :: elem
    1129             :       TYPE(message_send), POINTER                        :: m_send
    1130             :       TYPE(tmc_param_type), POINTER                      :: tmc_params
    1131             : 
    1132             :       INTEGER                                            :: counter, num_dim, rnd_seed_size
    1133             : 
    1134          57 :       CPASSERT(.NOT. ASSOCIATED(elem))
    1135          57 :       CPASSERT(ASSOCIATED(m_send))
    1136          57 :       CPASSERT(m_send%info(2) .GT. 5 .AND. m_send%info(3) .GT. 8)
    1137          57 :       CPASSERT(ASSOCIATED(tmc_params))
    1138             : 
    1139          57 :       counter = 0
    1140             :       !first integer array with number of dimensions and random seed size
    1141          57 :       rnd_seed_size = m_send%task_int(1 + m_send%task_int(1) + 1)
    1142             : 
    1143          57 :       IF (.NOT. ASSOCIATED(elem)) THEN
    1144             :          CALL allocate_new_sub_tree_node(next_el=elem, nr_dim=NINT(m_send%task_real(1)), &
    1145          57 :                                          tmc_params=tmc_params)
    1146             :       END IF
    1147             :       ! element status
    1148          57 :       counter = 2 + m_send%task_int(1)
    1149       98553 :       elem%elem_stat = m_send%task_int(2:counter - 1)
    1150       32889 :       elem%mol(:) = m_send%task_int(counter + 1:counter + m_send%task_int(counter))
    1151          57 :       counter = counter + 1 + m_send%task_int(counter)
    1152             :       ! element move type
    1153          57 :       elem%move_type = m_send%task_int(counter + 1)
    1154          57 :       counter = counter + 2
    1155          57 :       elem%nr = m_send%task_int(counter + 1)
    1156          57 :       counter = counter + 2
    1157          57 :       elem%sub_tree_nr = m_send%task_int(counter + 1)
    1158          57 :       counter = counter + 2
    1159          57 :       elem%temp_created = m_send%task_int(counter + 1)
    1160          57 :       counter = counter + 2
    1161          57 :       CPASSERT(counter .EQ. m_send%info(2))
    1162             : 
    1163          57 :       counter = 0
    1164             :       !then float array with pos, (vel), subbox_center and temp
    1165          57 :       num_dim = NINT(m_send%task_real(1))
    1166          57 :       counter = 2 + INT(m_send%task_real(1))
    1167       98553 :       elem%pos = m_send%task_real(2:counter - 1)
    1168          57 :       IF (msg_type .EQ. TMC_STAT_MD_REQUEST .OR. msg_type .EQ. TMC_STAT_MD_BROADCAST) THEN
    1169           0 :          elem%vel = m_send%task_real(counter + 1:counter + NINT(m_send%task_real(counter)))
    1170           0 :          counter = counter + NINT(m_send%task_real(counter)) + 1
    1171             :       END IF
    1172             :       ! rng seed
    1173        1596 :       elem%rng_seed(:, :, :) = RESHAPE(m_send%task_real(counter + 1:counter + SIZE(elem%rng_seed)), (/3, 2, 3/))
    1174          57 :       counter = counter + NINT(m_send%task_real(counter)) + 1
    1175             :       ! sub box center
    1176         399 :       elem%subbox_center(:) = m_send%task_real(counter + 1:counter + INT(m_send%task_real(counter)))
    1177          57 :       counter = counter + 1 + NINT(m_send%task_real(counter))
    1178             : 
    1179          57 :       IF (tmc_params%pressure .GE. 0.0_dp) THEN
    1180         238 :          elem%box_scale(:) = m_send%task_real(counter + 1:counter + INT(m_send%task_real(counter)))
    1181          34 :          counter = counter + 1 + INT(m_send%task_real(counter))
    1182             :       ELSE
    1183          92 :          elem%box_scale(:) = 1.0_dp
    1184             :       END IF
    1185             : 
    1186          57 :       CPASSERT(counter .EQ. m_send%info(3))
    1187          57 :       CPASSERT(m_send%task_int(m_send%info(2)) .EQ. message_end_flag)
    1188          57 :       CPASSERT(INT(m_send%task_real(m_send%info(3))) .EQ. message_end_flag)
    1189          57 :    END SUBROUTINE read_NMC_request_massage
    1190             : 
    1191             :    !============================================================================
    1192             :    ! Nested Monte Carlo RESULT messages
    1193             :    !============================================================================
    1194             : ! **************************************************************************************************
    1195             : !> \brief creating message for Nested Monte Carlo sampling result
    1196             : !> \param msg_type the status tag
    1197             : !> \param elem tree element  with calculated energy
    1198             : !> \param m_send the message structure
    1199             : !> \param tmc_params environment with move types and sizes
    1200             : !> \author Mandes 12.2012
    1201             : ! **************************************************************************************************
    1202          57 :    SUBROUTINE create_NMC_result_massage(msg_type, elem, m_send, tmc_params)
    1203             :       INTEGER                                            :: msg_type
    1204             :       TYPE(tree_type), POINTER                           :: elem
    1205             :       TYPE(message_send), POINTER                        :: m_send
    1206             :       TYPE(tmc_param_type), POINTER                      :: tmc_params
    1207             : 
    1208             :       INTEGER                                            :: counter, msg_size_int, msg_size_real
    1209             : 
    1210          57 :       CPASSERT(ASSOCIATED(m_send))
    1211          57 :       CPASSERT(.NOT. ALLOCATED(m_send%task_int))
    1212          57 :       CPASSERT(.NOT. ALLOCATED(m_send%task_real))
    1213          57 :       CPASSERT(ASSOCIATED(elem))
    1214          57 :       CPASSERT(ASSOCIATED(tmc_params))
    1215             : 
    1216             :       !first integer array with status, nmc_acc_counts, subbox_acc_count and (subbox rejectance)
    1217             :       msg_size_int = 1 + SIZE(elem%mol) &
    1218             :                      + 1 + SIZE(tmc_params%nmc_move_types%mv_count) &
    1219          57 :                      + 1 + SIZE(tmc_params%nmc_move_types%acc_count) + 1
    1220             :       IF (DEBUG .GT. 0) msg_size_int = msg_size_int + 1 + 1 + 1 + 1
    1221          99 :       IF (.NOT. ANY(tmc_params%sub_box_size .LE. 0.1_dp)) &
    1222             :          msg_size_int = msg_size_int + 1 + SIZE(tmc_params%nmc_move_types%subbox_count) &
    1223          14 :                         + 1 + SIZE(tmc_params%nmc_move_types%subbox_acc_count)
    1224             : 
    1225         171 :       ALLOCATE (m_send%task_int(msg_size_int))
    1226          57 :       counter = 1
    1227             :       IF (DEBUG .GT. 0) THEN
    1228             :          ! send the element number back
    1229             :          m_send%task_int(counter) = 1
    1230             :          m_send%task_int(counter + 1) = elem%sub_tree_nr
    1231             :          counter = counter + 1 + m_send%task_int(counter)
    1232             :          m_send%task_int(counter) = 1
    1233             :          m_send%task_int(counter + 1) = elem%nr
    1234             :          counter = counter + 1 + m_send%task_int(counter)
    1235             :       END IF
    1236             :       ! the molecule information
    1237          57 :       m_send%task_int(counter) = SIZE(elem%mol)
    1238       32889 :       m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = elem%mol(:)
    1239          57 :       counter = counter + 1 + m_send%task_int(counter)
    1240             :       ! the counters for each move type
    1241          57 :       m_send%task_int(counter) = SIZE(tmc_params%nmc_move_types%mv_count)
    1242             :       m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = &
    1243             :          RESHAPE(tmc_params%nmc_move_types%mv_count(:, :), &
    1244         785 :                  (/SIZE(tmc_params%nmc_move_types%mv_count)/))
    1245          57 :       counter = counter + 1 + m_send%task_int(counter)
    1246             :       ! the counter for the accepted moves
    1247          57 :       m_send%task_int(counter) = SIZE(tmc_params%nmc_move_types%acc_count)
    1248             :       m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = &
    1249             :          RESHAPE(tmc_params%nmc_move_types%acc_count(:, :), &
    1250         785 :                  (/SIZE(tmc_params%nmc_move_types%acc_count)/))
    1251          57 :       counter = counter + 1 + m_send%task_int(counter)
    1252             :       ! amount of rejected subbox moves
    1253          99 :       IF (.NOT. ANY(tmc_params%sub_box_size .LE. 0.1_dp)) THEN
    1254          14 :          m_send%task_int(counter) = SIZE(tmc_params%nmc_move_types%subbox_count)
    1255             :          m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = &
    1256             :             RESHAPE(tmc_params%nmc_move_types%subbox_count(:, :), &
    1257         168 :                     (/SIZE(tmc_params%nmc_move_types%subbox_count)/))
    1258          14 :          counter = counter + 1 + m_send%task_int(counter)
    1259          14 :          m_send%task_int(counter) = SIZE(tmc_params%nmc_move_types%subbox_acc_count)
    1260             :          m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = &
    1261             :             RESHAPE(tmc_params%nmc_move_types%subbox_acc_count(:, :), &
    1262         168 :                     (/SIZE(tmc_params%nmc_move_types%subbox_acc_count)/))
    1263          14 :          counter = counter + 1 + m_send%task_int(counter)
    1264             :       END IF
    1265          57 :       m_send%task_int(counter) = message_end_flag ! message end
    1266             : 
    1267          57 :       counter = 0
    1268             :       !then float array with pos,(vel, e_kin_befor_md, ekin),(forces),rng_seed,
    1269             :       !                       potential,e_pot_approx,acc_prob,subbox_prob
    1270             :       msg_size_real = 1 + SIZE(elem%pos) & ! pos
    1271             :                       + 1 + SIZE(elem%rng_seed) & ! rng_seed
    1272             :                       + 1 + 1 & ! potential
    1273             :                       + 1 + 1 & ! e_pot_approx
    1274          57 :                       + 1 ! check bit
    1275             : 
    1276          57 :       IF (msg_type .EQ. TMC_STAT_MD_REQUEST .OR. msg_type .EQ. TMC_STAT_MD_RESULT .OR. &
    1277             :           msg_type .EQ. TMC_STAT_MD_BROADCAST) &
    1278           0 :          msg_size_real = msg_size_real + 1 + SIZE(elem%vel) + 1 + 1 + 1 + 1 ! for MD also: vel, e_kin_befor_md, ekin
    1279             : 
    1280         171 :       ALLOCATE (m_send%task_real(msg_size_real))
    1281             :       ! pos
    1282          57 :       counter = 1
    1283          57 :       m_send%task_real(counter) = SIZE(elem%pos)
    1284       98553 :       m_send%task_real(counter + 1:counter + NINT(m_send%task_real(counter))) = elem%pos
    1285          57 :       counter = counter + 1 + NINT(m_send%task_real(counter))
    1286             :       ! rng seed
    1287          57 :       m_send%task_real(counter) = SIZE(elem%rng_seed)
    1288             :       m_send%task_real(counter + 1:counter + SIZE(elem%rng_seed)) = &
    1289        1083 :          RESHAPE(elem%rng_seed(:, :, :), (/SIZE(elem%rng_seed)/))
    1290          57 :       counter = counter + 1 + NINT(m_send%task_real(counter))
    1291             :       ! potential
    1292          57 :       m_send%task_real(counter) = 1
    1293          57 :       m_send%task_real(counter + 1) = elem%potential
    1294          57 :       counter = counter + 2
    1295             :       ! approximate potential energy
    1296          57 :       m_send%task_real(counter) = 1
    1297          57 :       m_send%task_real(counter + 1) = elem%e_pot_approx
    1298          57 :       counter = counter + 2
    1299             :       ! for MD also: vel, e_kin_befor_md, ekin
    1300          57 :       IF (msg_type .EQ. TMC_STAT_MD_REQUEST .OR. msg_type .EQ. TMC_STAT_MD_RESULT .OR. &
    1301             :           msg_type .EQ. TMC_STAT_MD_BROADCAST) THEN
    1302           0 :          m_send%task_real(counter) = SIZE(elem%vel)
    1303           0 :          m_send%task_real(counter + 1:counter + NINT(m_send%task_real(counter))) = elem%vel
    1304           0 :          counter = counter + 1 + INT(m_send%task_real(counter))
    1305           0 :          m_send%task_real(counter) = 1
    1306           0 :          m_send%task_real(counter + 1) = elem%ekin_before_md
    1307           0 :          counter = counter + 2
    1308           0 :          m_send%task_real(counter) = 1
    1309           0 :          m_send%task_real(counter + 1) = elem%ekin
    1310           0 :          counter = counter + 2
    1311             :       END IF
    1312          57 :       m_send%task_real(counter) = message_end_flag ! message end
    1313             : 
    1314          57 :       CPASSERT(SIZE(m_send%task_int) .EQ. msg_size_int)
    1315          57 :       CPASSERT(SIZE(m_send%task_real) .EQ. msg_size_real)
    1316          57 :       CPASSERT(m_send%task_int(msg_size_int) .EQ. message_end_flag)
    1317          57 :       CPASSERT(INT(m_send%task_real(msg_size_real)) .EQ. message_end_flag)
    1318          57 :    END SUBROUTINE create_NMC_result_massage
    1319             : 
    1320             : ! **************************************************************************************************
    1321             : !> \brief reading message for Nested Monte Carlo sampling result
    1322             : !> \param msg_type the status tag
    1323             : !> \param elem tree element  with calculated energy
    1324             : !> \param m_send the message structure
    1325             : !> \param tmc_params environment with move types and sizes
    1326             : !> \author Mandes 12.2012
    1327             : ! **************************************************************************************************
    1328          57 :    SUBROUTINE read_NMC_result_massage(msg_type, elem, m_send, tmc_params)
    1329             :       INTEGER                                            :: msg_type
    1330             :       TYPE(tree_type), POINTER                           :: elem
    1331             :       TYPE(message_send), POINTER                        :: m_send
    1332             :       TYPE(tmc_param_type), POINTER                      :: tmc_params
    1333             : 
    1334             :       INTEGER                                            :: counter
    1335          57 :       INTEGER, DIMENSION(:, :), POINTER                  :: acc_counter, mv_counter, &
    1336          57 :                                                             subbox_acc_counter, subbox_counter
    1337             : 
    1338          57 :       NULLIFY (mv_counter, subbox_counter, acc_counter, subbox_acc_counter)
    1339             : 
    1340           0 :       CPASSERT(ASSOCIATED(elem))
    1341          57 :       CPASSERT(ASSOCIATED(m_send))
    1342          57 :       CPASSERT(m_send%info(2) .GT. 0 .AND. m_send%info(3) .GT. 0)
    1343          57 :       CPASSERT(ASSOCIATED(tmc_params))
    1344             : 
    1345             :       !first integer array with element status, random number seed, and move type
    1346          57 :       counter = 1
    1347             :       IF (DEBUG .GT. 0) THEN
    1348             :          IF ((m_send%task_int(counter + 1) .NE. elem%sub_tree_nr) .AND. (m_send%task_int(counter + 3) .NE. elem%nr)) THEN
    1349             :             CPABORT("read_NMC_result_massage: got result of wrong element")
    1350             :          ENDIF
    1351             :          counter = counter + 2 + 2
    1352             :       END IF
    1353             :       ! the molecule information
    1354       32889 :       elem%mol(:) = m_send%task_int(counter + 1:counter + m_send%task_int(counter))
    1355          57 :       counter = counter + 1 + m_send%task_int(counter)
    1356             :       ! the counters for each move type
    1357             :       ALLOCATE (mv_counter(0:SIZE(tmc_params%nmc_move_types%mv_count(:, 1)) - 1, &
    1358         228 :                            SIZE(tmc_params%nmc_move_types%mv_count(1, :))))
    1359             :       mv_counter(:, :) = RESHAPE(m_send%task_int(counter + 1:counter + m_send%task_int(counter)), &
    1360             :                                  (/SIZE(tmc_params%nmc_move_types%mv_count(:, 1)), &
    1361         903 :                                    SIZE(tmc_params%nmc_move_types%mv_count(1, :))/))
    1362          57 :       counter = counter + 1 + m_send%task_int(counter)
    1363             :       ! the counter for the accepted moves
    1364             :       ALLOCATE (acc_counter(0:SIZE(tmc_params%nmc_move_types%acc_count(:, 1)) - 1, &
    1365         228 :                             SIZE(tmc_params%nmc_move_types%acc_count(1, :))))
    1366             :       acc_counter(:, :) = RESHAPE(m_send%task_int(counter + 1:counter + m_send%task_int(counter)), &
    1367             :                                   (/SIZE(tmc_params%nmc_move_types%acc_count(:, 1)), &
    1368         903 :                                     SIZE(tmc_params%nmc_move_types%acc_count(1, :))/))
    1369          57 :       counter = counter + 1 + m_send%task_int(counter)
    1370             :       ! amount of rejected subbox moves
    1371          99 :       IF (.NOT. ANY(tmc_params%sub_box_size .LE. 0.1_dp)) THEN
    1372             :          ALLOCATE (subbox_counter(SIZE(tmc_params%nmc_move_types%subbox_count(:, 1)), &
    1373          56 :                                   SIZE(tmc_params%nmc_move_types%subbox_count(1, :))))
    1374             :          subbox_counter(:, :) = RESHAPE(m_send%task_int(counter + 1:counter + m_send%task_int(counter)), &
    1375             :                                         (/SIZE(tmc_params%nmc_move_types%subbox_count(:, 1)), &
    1376         196 :                                           SIZE(tmc_params%nmc_move_types%subbox_count(1, :))/))
    1377          14 :          counter = counter + 1 + m_send%task_int(counter)
    1378             :          ALLOCATE (subbox_acc_counter(SIZE(tmc_params%nmc_move_types%subbox_acc_count(:, 1)), &
    1379          56 :                                       SIZE(tmc_params%nmc_move_types%subbox_acc_count(1, :))))
    1380             :          subbox_acc_counter(:, :) = RESHAPE(m_send%task_int(counter + 1:counter + m_send%task_int(counter)), &
    1381             :                                             (/SIZE(tmc_params%nmc_move_types%subbox_acc_count(:, 1)), &
    1382         196 :                                               SIZE(tmc_params%nmc_move_types%subbox_acc_count(1, :))/))
    1383          14 :          counter = counter + 1 + m_send%task_int(counter)
    1384             :       END IF
    1385          57 :       CPASSERT(counter .EQ. m_send%info(2))
    1386             : 
    1387             :       counter = 0
    1388             :       !then float array with pos, (vel, e_kin_befor_md, ekin), (forces), rng_seed, potential, e_pot_approx
    1389          57 :       counter = 1
    1390             :       ! pos
    1391       98553 :       elem%pos = m_send%task_real(counter + 1:counter + NINT(m_send%task_real(counter)))
    1392          57 :       counter = counter + 1 + NINT(m_send%task_real(counter))
    1393             :       ! rng seed
    1394        1596 :       elem%rng_seed(:, :, :) = RESHAPE(m_send%task_real(counter + 1:counter + SIZE(elem%rng_seed)), (/3, 2, 3/))
    1395          57 :       counter = counter + 1 + NINT(m_send%task_real(counter))
    1396             :       ! potential
    1397          57 :       elem%potential = m_send%task_real(counter + 1)
    1398          57 :       counter = counter + 2
    1399             :       ! approximate potential energy
    1400          57 :       elem%e_pot_approx = m_send%task_real(counter + 1)
    1401          57 :       counter = counter + 2
    1402             :       ! for MD also: vel, e_kin_befor_md, ekin
    1403          57 :       IF (msg_type .EQ. TMC_STAT_MD_REQUEST .OR. msg_type .EQ. TMC_STAT_MD_RESULT .OR. &
    1404             :           msg_type .EQ. TMC_STAT_MD_BROADCAST) THEN
    1405           0 :          elem%vel = m_send%task_real(counter + 1:counter + NINT(m_send%task_real(counter)))
    1406           0 :          counter = counter + 1 + INT(m_send%task_real(counter))
    1407           0 :          IF (.NOT. (tmc_params%task_type .EQ. task_type_gaussian_adaptation)) &
    1408           0 :             elem%ekin_before_md = m_send%task_real(counter + 1)
    1409           0 :          counter = counter + 2
    1410           0 :          elem%ekin = m_send%task_real(counter + 1)
    1411           0 :          counter = counter + 2
    1412             :       END IF
    1413             : 
    1414             :       CALL add_mv_prob(move_types=tmc_params%nmc_move_types, prob_opt=tmc_params%esimate_acc_prob, &
    1415          57 :                        mv_counter=mv_counter, acc_counter=acc_counter)
    1416          99 :       IF (.NOT. ANY(tmc_params%sub_box_size .LE. 0.1_dp)) THEN
    1417             :          CALL add_mv_prob(move_types=tmc_params%nmc_move_types, prob_opt=tmc_params%esimate_acc_prob, &
    1418          14 :                           subbox_counter=subbox_counter, subbox_acc_counter=subbox_acc_counter)
    1419             :       END IF
    1420             : 
    1421          57 :       DEALLOCATE (mv_counter, acc_counter)
    1422          99 :       IF (.NOT. ANY(tmc_params%sub_box_size .LE. 0.1_dp)) &
    1423          14 :          DEALLOCATE (subbox_counter, subbox_acc_counter)
    1424          57 :       CPASSERT(counter .EQ. m_send%info(3))
    1425          57 :       CPASSERT(m_send%task_int(m_send%info(2)) .EQ. message_end_flag)
    1426          57 :       CPASSERT(INT(m_send%task_real(m_send%info(3))) .EQ. message_end_flag)
    1427          57 :    END SUBROUTINE read_NMC_result_massage
    1428             : 
    1429             :    !============================================================================
    1430             :    ! Analysis element messages
    1431             :    !============================================================================
    1432             : ! **************************************************************************************************
    1433             : !> \brief creating message for requesting analysing a new configuration
    1434             : !>        we plot temperatur index into the sub tree number and
    1435             : !>        the Markov chain number into the element number
    1436             : !> \param list_elem ...
    1437             : !> \param m_send the message structure
    1438             : !> \param tmc_params stuct with parameters (global settings)
    1439             : !> \author Mandes 12.2012
    1440             : ! **************************************************************************************************
    1441           0 :    SUBROUTINE create_analysis_request_message(list_elem, m_send, &
    1442             :                                               tmc_params)
    1443             :       TYPE(elem_list_type), POINTER                      :: list_elem
    1444             :       TYPE(message_send), POINTER                        :: m_send
    1445             :       TYPE(tmc_param_type), POINTER                      :: tmc_params
    1446             : 
    1447             :       INTEGER                                            :: counter, msg_size_int, msg_size_real
    1448             : 
    1449           0 :       CPASSERT(ASSOCIATED(m_send))
    1450           0 :       CPASSERT(.NOT. ALLOCATED(m_send%task_int))
    1451           0 :       CPASSERT(.NOT. ALLOCATED(m_send%task_real))
    1452           0 :       CPASSERT(ASSOCIATED(list_elem))
    1453           0 :       CPASSERT(ASSOCIATED(tmc_params))
    1454             : 
    1455           0 :       counter = 0
    1456             :       !first integer array
    1457           0 :       msg_size_int = 1 + 1 + 1 + 1 + 1 ! 1+SIZE(list_elem%elem%sub_tree_nr) +1+SIZE(list_elem%elem%nr)
    1458           0 :       ALLOCATE (m_send%task_int(msg_size_int))
    1459           0 :       counter = 1
    1460           0 :       m_send%task_int(counter) = 1 ! temperature index
    1461           0 :       m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = list_elem%temp_ind
    1462           0 :       counter = counter + 1 + m_send%task_int(counter)
    1463           0 :       m_send%task_int(counter) = 1 ! Markov chain number
    1464           0 :       m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = list_elem%nr
    1465           0 :       counter = counter + 1 + m_send%task_int(counter)
    1466           0 :       m_send%task_int(counter) = message_end_flag
    1467           0 :       CPASSERT(SIZE(m_send%task_int) .EQ. msg_size_int)
    1468           0 :       CPASSERT(m_send%task_int(msg_size_int) .EQ. message_end_flag)
    1469             : 
    1470             :       !then float array with pos
    1471           0 :       msg_size_real = 1 + SIZE(list_elem%elem%pos) + 1
    1472           0 :       IF (tmc_params%pressure .GE. 0.0_dp) msg_size_real = msg_size_real + 1 + SIZE(list_elem%elem%box_scale(:))
    1473           0 :       ALLOCATE (m_send%task_real(msg_size_real))
    1474           0 :       m_send%task_real(1) = SIZE(list_elem%elem%pos)
    1475           0 :       counter = 2 + INT(m_send%task_real(1))
    1476           0 :       m_send%task_real(2:counter - 1) = list_elem%elem%pos
    1477           0 :       IF (tmc_params%pressure .GE. 0.0_dp) THEN
    1478           0 :          m_send%task_real(counter) = SIZE(list_elem%elem%box_scale)
    1479           0 :          m_send%task_real(counter + 1:counter + INT(m_send%task_real(counter))) = list_elem%elem%box_scale(:)
    1480           0 :          counter = counter + 1 + INT(m_send%task_real(counter))
    1481             :       END IF
    1482           0 :       m_send%task_real(counter) = REAL(message_end_flag, KIND=dp) !message end
    1483             : 
    1484           0 :       CPASSERT(SIZE(m_send%task_real) .EQ. msg_size_real)
    1485           0 :       CPASSERT(INT(m_send%task_real(msg_size_real)) .EQ. message_end_flag)
    1486           0 :    END SUBROUTINE create_analysis_request_message
    1487             : 
    1488             : ! **************************************************************************************************
    1489             : !> \brief reading message for requesting exact energy of new configuration
    1490             : !> \param elem tree element with new coordinates
    1491             : !> \param m_send the message structure
    1492             : !> \param tmc_params stuct with parameters (global settings)
    1493             : !> \author Mandes 12.2012
    1494             : ! **************************************************************************************************
    1495           0 :    SUBROUTINE read_analysis_request_message(elem, m_send, tmc_params)
    1496             :       TYPE(tree_type), POINTER                           :: elem
    1497             :       TYPE(message_send), POINTER                        :: m_send
    1498             :       TYPE(tmc_param_type), POINTER                      :: tmc_params
    1499             : 
    1500             :       INTEGER                                            :: counter
    1501             : 
    1502           0 :       CPASSERT(ASSOCIATED(m_send))
    1503           0 :       CPASSERT(m_send%info(3) .GT. 0)
    1504           0 :       CPASSERT(ASSOCIATED(tmc_params))
    1505           0 :       CPASSERT(.NOT. ASSOCIATED(elem))
    1506             : 
    1507             :       ! initialize the new sub tree element
    1508           0 :       IF (.NOT. ASSOCIATED(elem)) THEN
    1509             :          CALL allocate_new_sub_tree_node(next_el=elem, nr_dim=NINT(m_send%task_real(1)), &
    1510           0 :                                          tmc_params=tmc_params)
    1511             :       END IF
    1512             :       ! read the integer values
    1513           0 :       CPASSERT(m_send%info(2) .GT. 0)
    1514           0 :       counter = 1
    1515           0 :       elem%sub_tree_nr = m_send%task_int(counter + 1)
    1516           0 :       counter = counter + 1 + m_send%task_int(counter)
    1517           0 :       elem%nr = m_send%task_int(counter + 1)
    1518           0 :       counter = counter + 1 + m_send%task_int(counter)
    1519           0 :       CPASSERT(m_send%task_int(counter) .EQ. message_end_flag)
    1520             : 
    1521             :       !float array with pos
    1522           0 :       counter = 0
    1523           0 :       counter = 1 + NINT(m_send%task_real(1))
    1524           0 :       elem%pos = m_send%task_real(2:counter)
    1525           0 :       counter = counter + 1
    1526           0 :       IF (tmc_params%pressure .GE. 0.0_dp) THEN
    1527           0 :          elem%box_scale(:) = m_send%task_real(counter + 1:counter + INT(m_send%task_real(counter)))
    1528           0 :          counter = counter + 1 + INT(m_send%task_real(counter))
    1529             :       END IF
    1530             : 
    1531           0 :       CPASSERT(counter .EQ. m_send%info(3))
    1532           0 :       CPASSERT(INT(m_send%task_real(m_send%info(3))) .EQ. message_end_flag)
    1533           0 :    END SUBROUTINE read_analysis_request_message
    1534             : 
    1535             :    !============================================================================
    1536             :    ! SCF step energies (receiving from CP2K)
    1537             :    !============================================================================
    1538             : ! **************************************************************************************************
    1539             : !> \brief routine cancel the other group participants
    1540             : !> \param elem tree element  with approximated energy
    1541             : !> \param m_send the message structure
    1542             : !> \author Mandes 12.2012
    1543             : ! **************************************************************************************************
    1544           0 :    SUBROUTINE read_scf_step_ener(elem, m_send)
    1545             :       TYPE(tree_type), POINTER                           :: elem
    1546             :       TYPE(message_send), POINTER                        :: m_send
    1547             : 
    1548           0 :       CPASSERT(ASSOCIATED(elem))
    1549           0 :       CPASSERT(ASSOCIATED(m_send))
    1550             : 
    1551           0 :       elem%scf_energies(MOD(elem%scf_energies_count, 4) + 1) = m_send%task_real(1)
    1552           0 :       elem%scf_energies_count = elem%scf_energies_count + 1
    1553             : 
    1554           0 :    END SUBROUTINE read_scf_step_ener
    1555             : 
    1556             :    !============================================================================
    1557             :    ! message for broadcasting atom types
    1558             :    !============================================================================
    1559             : ! **************************************************************************************************
    1560             : !> \brief routines send atom names to the global master
    1561             : !>        (using broadcast in a specialized group consisting of the master
    1562             : !>        and the first energy worker master)
    1563             : !> \param atoms ...
    1564             : !> \param source ...
    1565             : !> \param para_env the communicator environment
    1566             : !> \author Mandes 12.2012
    1567             : ! **************************************************************************************************
    1568          28 :    SUBROUTINE communicate_atom_types(atoms, source, para_env)
    1569             :       TYPE(tmc_atom_type), DIMENSION(:), POINTER         :: atoms
    1570             :       INTEGER                                            :: source
    1571             :       TYPE(cp_para_env_type), POINTER                    :: para_env
    1572             : 
    1573             :       CHARACTER(LEN=default_string_length), &
    1574             :          ALLOCATABLE, DIMENSION(:)                       :: msg(:)
    1575             :       INTEGER                                            :: i
    1576             : 
    1577          28 :       CPASSERT(ASSOCIATED(para_env))
    1578          28 :       CPASSERT(source .GE. 0)
    1579          28 :       CPASSERT(source .LT. para_env%num_pe)
    1580             : 
    1581          84 :       ALLOCATE (msg(SIZE(atoms)))
    1582          28 :       IF (para_env%mepos .EQ. source) THEN
    1583        1894 :          DO i = 1, SIZE(atoms)
    1584        1894 :             msg(i) = atoms(i)%name
    1585             :          END DO
    1586          14 :          CALL mp_bcast(msg, source, para_env%group)
    1587             :       ELSE
    1588          14 :          CALL mp_bcast(msg, source, para_env%group)
    1589        1894 :          DO i = 1, SIZE(atoms)
    1590        1894 :             atoms(i)%name = msg(i)
    1591             :          END DO
    1592             :       END IF
    1593          28 :       DEALLOCATE (msg)
    1594          28 :    END SUBROUTINE communicate_atom_types
    1595             : 
    1596             :    !============================================================================
    1597             :    ! message for cancelation or stopping
    1598             :    !============================================================================
    1599             : ! **************************************************************************************************
    1600             : !> \brief send stop command to all group participants
    1601             : !> \param para_env ...
    1602             : !> \param worker_info ...
    1603             : !> \param tmc_params ...
    1604             : !> \param
    1605             : !> \param
    1606             : !> \author Mandes 01.2013
    1607             : ! **************************************************************************************************
    1608          42 :    SUBROUTINE stop_whole_group(para_env, worker_info, tmc_params)
    1609             :       TYPE(cp_para_env_type), POINTER                    :: para_env
    1610             :       TYPE(elem_array_type), DIMENSION(:), OPTIONAL, &
    1611             :          POINTER                                         :: worker_info
    1612             :       TYPE(tmc_param_type), POINTER                      :: tmc_params
    1613             : 
    1614             :       INTEGER                                            :: act_rank, dest_rank, stat
    1615             :       LOGICAL                                            :: flag
    1616          42 :       LOGICAL, ALLOCATABLE, DIMENSION(:)                 :: rank_stoped
    1617             : 
    1618             : !    INTEGER, DIMENSION(MPI_STATUS_SIZE)      :: status_single
    1619             : 
    1620          42 :       CPASSERT(ASSOCIATED(para_env))
    1621          42 :       CPASSERT(ASSOCIATED(tmc_params))
    1622             : 
    1623         126 :       ALLOCATE (rank_stoped(0:para_env%num_pe - 1))
    1624          98 :       rank_stoped(:) = .FALSE.
    1625          42 :       rank_stoped(para_env%mepos) = .TRUE.
    1626             : 
    1627             :       ! global master
    1628          42 :       IF (PRESENT(worker_info)) THEN
    1629          28 :          CPASSERT(ASSOCIATED(worker_info))
    1630             :          ! canceling running jobs and stop workers
    1631          42 :          worker_group_loop: DO dest_rank = 1, para_env%num_pe - 1
    1632             :             ! busy workers have to be canceled
    1633          42 :             IF (worker_info(dest_rank)%busy) THEN
    1634           1 :                stat = TMC_CANCELING_MESSAGE
    1635           1 :                act_rank = dest_rank
    1636             :                CALL tmc_message(msg_type=stat, send_recv=send_msg, dest=act_rank, &
    1637           1 :                                 para_env=para_env, tmc_params=tmc_params)
    1638             :             ELSE
    1639             :                ! send stop message
    1640          13 :                stat = TMC_STATUS_FAILED
    1641          13 :                act_rank = dest_rank
    1642             :                CALL tmc_message(msg_type=stat, send_recv=send_msg, dest=act_rank, &
    1643          13 :                                 para_env=para_env, tmc_params=tmc_params)
    1644             :             END IF
    1645             :          END DO worker_group_loop
    1646             :       ELSE
    1647             :          ! group master send stop message to all participants
    1648          14 :          stat = TMC_STATUS_FAILED
    1649             :          CALL tmc_message(msg_type=stat, send_recv=send_msg, dest=bcast_group, &
    1650          14 :                           para_env=para_env, tmc_params=tmc_params)
    1651             :       END IF
    1652             : 
    1653             :       ! receive stop message receipt
    1654          42 :       IF (para_env%mepos .EQ. MASTER_COMM_ID) THEN
    1655             :          wait_for_receipts: DO
    1656             :             ! check incomming messages
    1657          74 :             stat = TMC_STATUS_WAIT_FOR_NEW_TASK
    1658          74 :             dest_rank = 999
    1659          74 :             IF (PRESENT(worker_info)) THEN
    1660             :                ! mast have to be able to receive results, if canceling was too late
    1661             :                CALL tmc_message(msg_type=stat, send_recv=recv_msg, dest=dest_rank, &
    1662             :                                 para_env=para_env, tmc_params=tmc_params, &
    1663          60 :                                 elem_array=worker_info(:), success=flag)
    1664             :             ELSE
    1665             :                CALL tmc_message(msg_type=stat, send_recv=recv_msg, dest=dest_rank, &
    1666          14 :                                 para_env=para_env, tmc_params=tmc_params)
    1667             :             END IF
    1668           1 :             SELECT CASE (stat)
    1669             :             CASE (TMC_STATUS_WAIT_FOR_NEW_TASK)
    1670             :                ! no message received
    1671             :             CASE (TMC_CANCELING_RECEIPT)
    1672           1 :                IF (PRESENT(worker_info)) THEN
    1673           1 :                   worker_info(dest_rank)%busy = .FALSE.
    1674           1 :                   stat = TMC_STATUS_FAILED
    1675             :                   ! send stop message
    1676             :                   CALL tmc_message(msg_type=stat, send_recv=send_msg, dest=dest_rank, &
    1677           1 :                                    para_env=para_env, tmc_params=tmc_params)
    1678             :                ELSE
    1679           0 :                   CPABORT("group master should not receive cancel receipt")
    1680             :                END IF
    1681             :             CASE (TMC_STATUS_STOP_RECEIPT)
    1682          14 :                rank_stoped(dest_rank) = .TRUE.
    1683             :             CASE (TMC_STAT_ENERGY_RESULT, TMC_STAT_NMC_RESULT, TMC_STAT_MD_RESULT, &
    1684             :                   TMC_STAT_SCF_STEP_ENER_RECEIVE, TMC_STAT_APPROX_ENERGY_RESULT, TMC_STAT_ANALYSIS_RESULT)
    1685             :                ! nothing to do, canceling message already sent
    1686             :             CASE DEFAULT
    1687             :                CALL cp_abort(__LOCATION__, &
    1688             :                              "master received status "//cp_to_string(stat)// &
    1689          74 :                              " while stopping workers")
    1690             :             END SELECT
    1691         162 :             IF (ALL(rank_stoped)) EXIT wait_for_receipts
    1692             :          END DO wait_for_receipts
    1693             :       ELSE
    1694           0 :          CPABORT("only (group) master should stop other participants")
    1695             :       END IF
    1696          42 :    END SUBROUTINE stop_whole_group
    1697             : 
    1698           0 : END MODULE tmc_messages

Generated by: LCOV version 1.15