LCOV - code coverage report
Current view: top level - src/tmc - tmc_messages.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:42dac4a) Lines: 80.4 % 734 590
Test Date: 2025-07-25 12:55:17 Functions: 79.2 % 24 19

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

Generated by: LCOV version 2.0-1