sll_m_binary_io.F90

Go to the documentation of this file.

!**************************************************************
!  Copyright INRIA
!  Authors :
!     Pierre Navaro
!
!  This code SeLaLib (for Semi-Lagrangian-Library)
!  is a parallel library for simulating the plasma turbulence
!  in a tokamak.
!
!  This software is governed by the CeCILL-B license
!  under French law and abiding by the rules of distribution
!  of free software.  You can  use, modify and redistribute
!  the software under the terms of the CeCILL-B license as
!  circulated by CEA, CNRS and INRIA at the following URL
!  "http://www.cecill.info".
!**************************************************************
 
module sll_m_binary_io
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#include "sll_assert.h"
#include "sll_working_precision.h"
 
   implicit none
 
   public :: &
      sll_s_binary_file_close, &
      sll_s_binary_file_create, &
      sll_s_binary_read_array_0d, &
      sll_s_binary_read_array_2d, &
      sll_o_binary_write_array, &
      sll_s_binary_write_array_0d, &
      sll_s_binary_write_array_1d, &
      sll_s_binary_write_array_2d
 
   private
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
   interface sll_o_binary_write_array
      module procedure sll_s_binary_write_array_1d
      module procedure sll_s_binary_write_array_2d
      module procedure sll_s_binary_write_array_3d
   end interface
 
contains
 
   subroutine sll_s_binary_file_create(filename, file_id, error)
      character(len=*), intent(in)  :: filename
      sll_int32, intent(out) :: file_id    
      sll_int32, intent(out) :: error      
      logical                        :: lopen
 
      error = 0
 
      do 100 file_id = 20, 99
         inquire (unit=file_id, opened=lopen)
         if (lopen) then
            cycle
         else
            open (file_id, status='SCRATCH', err=100)
            close (file_id, status='DELETE', err=100)
            goto 200
         end if
 
100      continue
         error = 1
200      continue
         error = 0
 
         ! Create a new file using default properties
         inquire (file=filename, opened=lopen)
         sll_assert_always(.not. lopen)
 
         open (file_id, &
               file=filename, &
               access="STREAM", &
               form='UNFORMATTED', &
               iostat=error)
 
         end subroutine sll_s_binary_file_create
 
!subroutine sll_binary_file_open(file_id,error)
!sll_int32, intent(in)  :: file_id !<file unit number
!sll_int32, intent(out) :: error   !<error code
 
!open(file_id, IOSTAT=error)
 
!end subroutine sll_binary_file_open
 
         subroutine sll_s_binary_file_close(file_id, error)
            sll_int32, intent(in)  :: file_id 
            sll_int32, intent(out) :: error   
 
            close (file_id, iostat=error)
 
         end subroutine sll_s_binary_file_close
 
         subroutine sll_s_binary_write_array_0d(file_id, array, error)
            sll_int32, intent(in)       :: file_id  
            sll_int32, intent(out)      :: error    
            sll_real64, intent(in)       :: array 
            write (file_id, iostat=error) array
         end subroutine
 
         subroutine sll_s_binary_write_array_1d(file_id, array, error)
            sll_int32, intent(in)       :: file_id  
            sll_int32, intent(out)      :: error    
            sll_real64, intent(in)       :: array(:) 
            write (file_id, iostat=error) array
         end subroutine
 
         subroutine sll_s_binary_write_array_2d(file_id, array, error)
            sll_int32, intent(in)       :: file_id    
            sll_int32, intent(out)      :: error      
            sll_real64, intent(in)       :: array(:, :) 
            write (file_id, iostat=error) array
         end subroutine
 
         subroutine sll_s_binary_write_array_3d(file_id, array, error)
            sll_int32, intent(in)       :: file_id      
            sll_int32, intent(out)      :: error        
            sll_real64, intent(in)       :: array(:, :, :) 
            write (file_id, iostat=error) array
         end subroutine
 
         subroutine sll_s_binary_read_array_0d(file_id, array, error)
            sll_int32, intent(in)       :: file_id  
            sll_int32, intent(out)      :: error    
            sll_real64, intent(out)       :: array 
            read (file_id, iostat=error) array
         end subroutine
 
         subroutine sll_s_binary_read_array_2d(file_id, array, error)
            sll_int32, intent(in)       :: file_id    
            sll_int32, intent(out)      :: error      
            sll_real64, intent(out)       :: array(:, :) 
            read (file_id, iostat=error) array
         end subroutine
 
         end module sll_m_binary_io