matrix_pf.f90

Go to the documentation of this file.

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!! Time-stamp: <2016-10-18 15:31:47 pbrowne>
!!!
!!!    module to deal with generating and outputting pf matrix
!!!    Copyright (C) 2015 Philip A. Browne
!!!
!!!    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 3 of the License, or
!!!    (at your option) any later version.
!!!
!!!    This program is distributed in the hope that it will be useful,
!!!    but WITHOUT ANY WARRANTY; without even the implied warranty of
!!!    MERCHANTABILITY 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, see <http://www.gnu.org/licenses/>.
!!!
!!!    Email: p.browne @ reading.ac.uk
!!!    Mail:  School of Mathematical and Physical Sciences,
!!!           University of Reading,
!!!       Reading, UK
!!!       RG6 6BB
!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

module matrix_pf
  implicit none
  type, public :: matrix_pf_data
     
     character(30) :: prefix
     integer :: k
     logical :: analysis
     logical :: frequency
     integer :: output_type

  end type matrix_pf_data
  type(matrix_pf_data), save :: matpf
contains
  subroutine read_matrix_pf_information
    use output_empire, only : unit_nml,emp_e
    implicit none
    character(30) :: prefix
    integer :: k=0
    logical :: analysis=.false.
    logical :: frequency=.false.
    integer :: output_type=0
    logical :: file_exists
    integer :: ios
    namelist/mat_pf/k,analysis,frequency,prefix,output_type

    inquire(file='pf_parameters.dat',exist=file_exists)
    if(file_exists) then
       open(unit_nml,file='pf_parameters.dat',iostat=ios,action='read'&
            &,status='old')
       if(ios .ne. 0) then
          write(emp_e,*) 'Cannot open pf_parameters.dat'
          stop
       end if
    else
       inquire(file='empire.nml',exist=file_exists)
       if(file_exists) then
          open(unit_nml,file='empire.nml',iostat=ios,action='read'&
               &,status='old')
          if(ios .ne. 0) then
             write(emp_e,*) 'Cannot open empire.nml'
             stop
          end if
       else
          write(emp_e,*) 'ERROR: cannot find pf_parameters.dat or empire.nml'
          stop '-1'
       end if
    end if

    read(unit_nml,nml=mat_pf,iostat=ios) 
    close(unit_nml)

    if(ios .ne. 0) then
       print*,'mat_pf not found in namelist file.'
       print*,'no matrix_pf information will be computed'
    else

       matpf%prefix=trim(prefix)
       matpf%analysis = analysis
       matpf%frequency= frequency
       matpf%output_type=output_type

       if(k.gt.0) then
          matpf%k=k
       else
          write(emp_e,*) 'ERROR: k in matrix_pf_data read in less than 1'
          write(emp_e,*) 'ERROR: k should be a natural number'
          write(emp_e,*) 'STOPPING'
          stop '-1'
       end if
    end if

    print*,'matpf=',matpf
    call flush(6)
  end subroutine read_matrix_pf_information
  
  subroutine matrix_pf_output(root,comm,n,m,x,time,is_analysis)
    implicit none
    include 'mpif.h'
    integer, parameter :: rk = kind(1.0d0)
    integer, intent(in) :: root
    integer, intent(in) :: comm
    integer, intent(in) :: n
    integer, intent(in) :: m
    real(kind=rk), dimension(n,m) :: x
    integer, intent(in) :: time
    logical, intent(in) :: is_analysis

    character(40) :: filename
    logical :: actually_output=.false.
    real(kind=rk), dimension(n*(n+1)/2) :: pf
    integer :: rank,mpi_err

    actually_output = .false.

    !check if we should output:
    if(matpf%analysis .and. is_analysis) actually_output = .true.

    if(matpf%frequency .and. mod(time,matpf%k) .eq. 0) actually_output=.true.

    if(matpf%k .gt. 0) print*,'hello: mod(time,matpf%k) = ',mod(time,matpf%k)
    
    if(actually_output) then

       write(filename,'(A,i10.10)') trim(matpf%prefix),time
       
       call generate_pf(n,m,comm,x,pf)
       
       call mpi_comm_rank(comm,rank,mpi_err)
       if(rank .eq. root) call output_mat_tri(n,pf,filename,matpf%output_type)

    end if

  end subroutine matrix_pf_output
end module matrix_pf