td_write_classical.F90

Go to the documentation of this file.

! Copyright (C) 2002-2006 M. Marques, A. Castro, A. Rubio, G. Bertsch
!!
!! This program is free software; you can redistribute it and/or modify
!! it under the terms of the GNU General Public License as published by
!! the Free Software Foundation; either version 2, or (at your option)
!! any later version.
!!
!! This program is distributed in the hope that it will be useful,
!! but WITHOUT ANY WARRANTY; without even the implied warranty of
!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!! GNU General Public License for more details.
!!
!! You should have received a copy of the GNU General Public License
!! along with this program; if not, write to the Free Software
!! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
!! 02110-1301, USA.
!!
 
#include "global.h"
 
module td_write_classical_oct_m
  use debug_oct_m
  use global_oct_m
  use output_low_oct_m
  use io_function_oct_m
  use io_oct_m
  use messages_oct_m
  use mpi_oct_m
  use namespace_oct_m
  use profiling_oct_m
  use space_oct_m
  use td_write_low_oct_m
  use unit_oct_m
  use unit_system_oct_m
  use write_iter_oct_m
 
  implicit none
 
  private
 
  public ::                     &
    td_write_coordinates,       &
    td_write_sep_coordinates
 
contains
 
  ! ---------------------------------------------------------
  subroutine td_write_coordinates(out_coords, natoms, space, pos, vel, tot_forces, iter)
    type(c_ptr),       intent(inout) :: out_coords
    integer,           intent(in)    :: natoms
    class(space_t),    intent(in)    :: space
    real(real64),      intent(in)    :: pos(:,:)
    real(real64),      intent(in)    :: vel(:,:)
    real(real64),      intent(in)    :: tot_forces(:,:)
    integer,           intent(in)    :: iter
 
    integer :: iatom, idir
    character(len=50) :: aux
    real(real64) :: tmp(space%dim)
 
    if (.not. mpi_world%is_root()) return ! only first node outputs
 
    push_sub(td_write_coordinates)
 
    if (iter == 0) then
      call td_write_print_header_init(out_coords)
 
      ! first line: column names
      call write_iter_header_start(out_coords)
 
      do iatom = 1, natoms
        do idir = 1, space%dim
          write(aux, '(a2,i0,a1,i1,a1)') 'x(', iatom, ',', idir, ')'
          call write_iter_header(out_coords, aux)
        end do
      end do
      do iatom = 1, natoms
        do idir = 1, space%dim
          write(aux, '(a2,i0,a1,i1,a1)') 'v(', iatom, ',', idir,')'
          call write_iter_header(out_coords, aux)
        end do
      end do
      do iatom = 1, natoms
        do idir = 1, space%dim
          write(aux, '(a2,i0,a1,i1,a1)') 'f(', iatom, ',', idir,')'
          call write_iter_header(out_coords, aux)
        end do
      end do
      call write_iter_nl(out_coords)
 
      ! second line: units
      call write_iter_string(out_coords, '#[Iter n.]')
      call write_iter_header(out_coords, '[' // trim(units_abbrev(units_out%time)) // ']')
      call write_iter_string(out_coords, &
        'Positions in '   // trim(units_abbrev(units_out%length))   //   &
        ', Velocities in '// trim(units_abbrev(units_out%velocity)) //   &
        ', Forces in '    // trim(units_abbrev(units_out%force)))
      call write_iter_nl(out_coords)
 
      call td_write_print_header_end(out_coords)
    end if
 
    call write_iter_start(out_coords)
 
    do iatom = 1, natoms
      tmp(1:space%dim) = units_from_atomic(units_out%length, pos(:, iatom))
      call write_iter_double(out_coords, tmp, space%dim)
    end do
    do iatom = 1, natoms
      tmp(1:space%dim) = units_from_atomic(units_out%velocity, vel(:, iatom))
      call write_iter_double(out_coords, tmp, space%dim)
    end do
    do iatom = 1, natoms
      tmp(1:space%dim) = units_from_atomic(units_out%force, tot_forces(:, iatom))
      call write_iter_double(out_coords, tmp, space%dim)
    end do
    call write_iter_nl(out_coords)
 
    pop_sub(td_write_coordinates)
  end subroutine td_write_coordinates
 
  ! ---------------------------------------------------------
  subroutine td_write_sep_coordinates(out_coords, natoms, space, pos, vel, tot_forces, iter, which)
    type(c_ptr),       intent(inout) :: out_coords
    integer,           intent(in)    :: natoms
    class(space_t),    intent(in)    :: space
    real(real64),      intent(in)    :: pos(:,:)
    real(real64),      intent(in)    :: vel(:,:)
    real(real64),      intent(in)    :: tot_forces(:,:)
    integer,           intent(in)    :: iter
    integer,           intent(in)    :: which !1=xyz, 2=velocity, 3=force
 
    integer, parameter :: COORDINATES=1
    integer, parameter :: VELOCITIES=2
    integer, parameter :: FORCES=3
    integer :: iatom, idir
    character(len=50) :: aux
    real(real64) :: tmp(space%dim)
 
    if (.not. mpi_world%is_root()) return ! only first node outputs
 
    push_sub(td_write_sep_coordinates)
 
    if (iter == 0) then
      call td_write_print_header_init(out_coords)
 
      ! first line: column names
      call write_iter_header_start(out_coords)
 
      do iatom = 1, natoms
        do idir = 1, space%dim
          select case (which)
          case (coordinates)
            write(aux, '(a2,i0,a1,i1,a1)') 'x(', iatom, ',', idir, ')'
          case (velocities)
            write(aux, '(a2,i0,a1,i1,a1)') 'v(', iatom, ',', idir,')'
          case (forces)
            write(aux, '(a2,i0,a1,i1,a1)') 'f(', iatom, ',', idir,')'
          case default
            assert(.false.)
          end select
          call write_iter_header(out_coords, aux)
        end do
      end do
      call write_iter_nl(out_coords)
 
      ! second line: units
      call write_iter_string(out_coords, '#[Iter n.]')
      call write_iter_header(out_coords, '[' // trim(units_abbrev(units_out%time)) // ']')
      select case (which)
      case (coordinates)
        call write_iter_string(out_coords, &
          'Positions in '   // trim(units_abbrev(units_out%length)))
      case (velocities)
        call write_iter_string(out_coords, &
          'Velocities in '  // trim(units_abbrev(units_out%velocity)))
      case (forces)
        call write_iter_string(out_coords, &
          'Forces in '    // trim(units_abbrev(units_out%force)))
      end select
      call write_iter_nl(out_coords)
 
      call td_write_print_header_end(out_coords)
    end if
 
    call write_iter_start(out_coords)
 
    select case (which)
    case (coordinates)
      do iatom = 1, natoms
        tmp(1:space%dim) = units_from_atomic(units_out%length, pos(:, iatom))
        call write_iter_double(out_coords, tmp, space%dim)
      end do
    case (velocities)
      do iatom = 1, natoms
        tmp(1:space%dim) = units_from_atomic(units_out%velocity, vel(:, iatom))
        call write_iter_double(out_coords, tmp, space%dim)
      end do
    case (forces)
      do iatom = 1, natoms
        tmp(1:space%dim) = units_from_atomic(units_out%force, tot_forces(:, iatom))
        call write_iter_double(out_coords, tmp, space%dim)
      end do
    end select
 
    call write_iter_nl(out_coords)
 
    pop_sub(td_write_sep_coordinates)
  end subroutine td_write_sep_coordinates
 
end module td_write_classical_oct_m
 
!! Local Variables:
!! mode: f90
!! coding: utf-8
!! End: