module ARQUIVO

! sigla = ARQUIVO_

! objetivo: executar funções gerais relacionadas a arquivos
!           de dados e de saídas

! versão original 1.0 (20 Mai 99)

! programador: Carlos Henrique Marchi
! local:       SINMEC/UFSC - Florianópolis - SC

! versão atual    1.2 ( 6 Dez 99)

! última alteração =   19 Jan 00

!-------------------------------------------------

! RELAÇÃO DAS ROTINAS DESTE MÓDULO:

  ! ARQUIVO_acessa_diretorio
  ! ARQUIVO_copia_arquivo
  ! ARQUIVO_cria_arquivo
  ! ARQUIVO_cria_arquivo_binario
  ! ARQUIVO_cria_diretorio
  ! ARQUIVO_cronometro
  ! ARQUIVO_escreve_campo_1D
  ! ARQUIVO_escreve_data
  ! ARQUIVO_escreve_data_hora
  ! ARQUIVO_escreve_hora
  ! ARQUIVO_escreve_tempo_cpu
  ! ARQUIVO_fecha_frame
  ! ARQUIVO_grava_campo_1D
  ! ARQUIVO_grava_campo_e_tubeira
  ! ARQUIVO_le_dados
  ! ARQUIVO_le_inicio
  ! ARQUIVO_lista_arquivos
  ! ARQUIVO_notepad_abre_dado
  ! ARQUIVO_notepad_abre_saida
  ! ARQUIVO_passa_caminho_programa
  ! ARQUIVO_passa_caso
  ! ARQUIVO_passa_data
  ! ARQUIVO_passa_diretorio_trabalho
  ! ARQUIVO_passa_hora
  ! ARQUIVO_remove_arquivo

!-------------------------------------------------

! rotinas onde são lidos ARQUIVOS de dados neste MÓDULO:

  ! ARQUIVO_le_dados
  ! ARQUIVO_le_inicio

!-------------------------------------------------

! rotinas onde são gerados ARQUIVOS neste MÓDULO:

  ! ARQUIVO_cria_arquivo
  ! ARQUIVO_cria_arquivo_binario
  ! ARQUIVO_cria_diretorio
  ! ARQUIVO_notepad_abre_saida
  ! ARQUIVO_remove_arquivo

!-------------------------------------------------

! programas auxiliares usados neste MÓDULO:

  ! notepad.exe

!-------------------------------------------------

USE DFLIB 
use msflib
use msfwin
use portlib

!-------------------------------------------------

implicit none

logical,private :: dos ! acessa prompt dos

character*150,private :: caminho_programa   ! nome do diretório onde está instalado o programa

character*150,private :: diretorio_trabalho ! nome do diretório para saídas

character*50, private :: nome_caso  ! nome do caso

character*220,private :: comando    ! linha de comando

integer,private :: lista ! lista conteúdo do arquivo de dados do módulo ARQUIVO

integer,private :: le    ! lê conteúdo do arquivo de dados do módulo ARQUIVO

integer,private :: copia ! gera back up do arquivo de dados do módulo ARQUIVO

character*50,private :: nome_dados ! nome do arquivo de dados do módulo ARQUIVO

! -----------------------------------------------

contains

!-------------------------------------------------

  subroutine ARQUIVO_acessa_diretorio ( nome_diretorio )

    logical       :: dos    ! acessa prompt dos
    character*160 :: acessa ! acessa diretório
    character*(*),intent(in) :: nome_diretorio ! nome do diretório

    acessa = 'cd '//trim(nome_diretorio)

    dos = systemqq ( acessa )

  end subroutine ARQUIVO_acessa_diretorio

!-------------------------------------------------

  subroutine ARQUIVO_copia_arquivo ( nome_arquivo )

    character*(*),intent(in) :: nome_arquivo ! nome do arquivo

    comando = "copy " // trim(nome_arquivo) // " " // trim(diretorio_trabalho) // &
              trim(nome_caso) // "." // trim(nome_arquivo)

    dos = systemqq ( comando )

  end subroutine ARQUIVO_copia_arquivo

!-------------------------------------------------

  subroutine ARQUIVO_cria_arquivo ( unit, nome_arquivo )

    integer,intent(in)       :: unit          ! identificador do arquivo
    character*(*),intent(in) :: nome_arquivo  ! nome do arquivo

    comando = trim(diretorio_trabalho) // trim(nome_arquivo)
   
    open ( unit, file = comando )

  end subroutine ARQUIVO_cria_arquivo

!-------------------------------------------------

  subroutine ARQUIVO_cria_arquivo_binario ( unit, nome_arquivo )

    integer,intent(in)       :: unit          ! identificador do arquivo
    character*(*),intent(in) :: nome_arquivo  ! nome do arquivo

    comando = trim(diretorio_trabalho) // trim(nome_arquivo)
   
    open ( unit, file = comando, form = 'unformatted' )

  end subroutine ARQUIVO_cria_arquivo_binario

!-------------------------------------------------

  subroutine ARQUIVO_cria_diretorio ( unit )

    integer, intent(in) :: unit ! unidade do arquivo

    open ( unit, file = 'executa.bat' )

    write ( unit, * ) 'cd ' // trim(caminho_programa)
    write ( unit, * ) 'mkdir ' // trim(diretorio_trabalho)

    close ( unit )

    dos = systemqq ( 'executa.bat' )

  end subroutine ARQUIVO_cria_diretorio

!-------------------------------------------------

  subroutine ARQUIVO_cronometro ( tcpu )

    real*8,intent(inout) :: tcpu ! tempo de processamento

    call cpu_time(tcpu) 

  end subroutine ARQUIVO_cronometro

!-------------------------------------------------

  subroutine ARQUIVO_escreve_campo_1D ( unit,   w,      head_0, head_1, head_2, &
                                        head_3, n_ini,  n,      x,      T       )

    integer,intent(in)             :: unit   ! identificador do arquivo
    integer,intent(in)             :: w      ! freqüência de escrita; 0=não escreve
    integer,intent(in)             :: n_ini  ! ponto ou volume inicial de escrita
    character*(*),intent(in)       :: head_0 ! título do campo
    character*(*),intent(in)       :: head_1 ! título da primeira coluna
    character*(*),intent(in)       :: head_2 ! título da segunda coluna
    character*(*),intent(in)       :: head_3 ! título da terceira coluna
    integer,intent(in)             :: n      ! número de dados a escrever
    real*8,intent(in),dimension(:) :: x      ! coordenada espacial
    real*8,intent(in),dimension(:) :: T      ! variável a escrever

    real*8  :: T_min, T_max ! extremos do campo
    real*8  :: x_min, x_max ! coordenadas dos extremos do campo
    integer :: i ! número do dado

!   head_0 = inicia na coluna 1  ; formato A50
!   head_1 = inicia na coluna 1  ; formato A6
!   head_2 = inicia na coluna 11 ; formato A21
!   head_3 = inicia na coluna 36 ; formato A21
!   inteiro: formato I6
!   real   : formato 1pe25.15

    if ( w == 0 ) return

    write(unit,1) head_0, head_1, head_2, head_3 
    1 format(//,t1, a50, &
             //,t1, a6,   t11, a21,   t36, a21, / )
    do i = n_ini, n
       if ( i==n_ini .or. i==n .or. mod(i,w)==0 ) &
          write(unit,2) i, x(i), T(i)
    end do

    2 format(i6,2(1pe25.15))

    T_min = T(n_ini)
    T_max = T(n_ini)

    do i = n_ini, n
       if ( T(i) <= T_min ) then
          T_min = T(i)
          x_min = x(i)
       end if
       if ( T(i) >= T_max ) then
          T_max = T(i)
          x_max = x(i)
       end if
    end do

    write(unit,3) T_min, x_min, T_max, x_max
    3 format(/,1pe25.15,' = mínimo',1pe25.15,' = X (m)',/, &
               1pe25.15,' = máximo',1pe25.15,' = X (m)') 

  end subroutine ARQUIVO_escreve_campo_1D

!-------------------------------------------------

  subroutine ARQUIVO_escreve_data ( unit )

    integer,intent(in) :: unit ! arquivo
    integer*4    :: var(8)     ! data e hora
    character*2  :: aux1,aux2  ! auxiliares
    character*4  :: aux3       ! auxiliar
    character*12 :: dia        ! data
    character*20 :: vardate,vartime,varzone ! data e hora
    character*50 :: aux		   ! auxiliar

    call date_and_time(vardate,vartime,varzone,var)

    write(aux,*) var(3)
    aux1 = trim(adjustl(aux))
    write(aux,*) var(2)
    aux2 = trim(adjustl(aux))
    write(aux,*) var(1)
    aux3 = trim(adjustl(aux))

    dia = '('//trim(aux1)//'/'//trim(aux2)//'/'//aux3//')'

    write(unit,1) dia
    1 format(5x,'Dia = ',a12)

  end subroutine ARQUIVO_escreve_data

!-------------------------------------------------

  subroutine ARQUIVO_escreve_data_hora ( unit )

    integer,intent(in) :: unit ! arquivo
    integer*4    :: var(8)     ! data e hora
    character*2  :: aux1,aux2  ! auxiliares
    character*4  :: aux3       ! auxiliar
    character*8  :: hora       ! horário
    character*12 :: dia        ! data
    character*20 :: vardate,vartime,varzone ! data e hora
    character*50 :: aux		   ! auxiliar

    call date_and_time(vardate,vartime,varzone,var)

    write(aux,*) var(3)
    aux1 = trim(adjustl(aux))
    write(aux,*) var(2)
    aux2 = trim(adjustl(aux))
    write(aux,*) var(1)
    aux3 = trim(adjustl(aux))

    dia = '('//trim(aux1)//'/'//trim(aux2)//'/'//aux3//')'

    write(aux,*) var(5)
    aux1 = trim(adjustl(aux))
    write(aux,*) var(6)
    aux2 = trim(adjustl(aux))
    write(aux,*) var(7)
    aux3 = trim(adjustl(aux))
    
	hora = trim(aux1)//':'//trim(aux2)//':'//aux3

    write(unit,1) dia, hora
    1 format(5x,'Dia = ',a12,5x,'Hora = ',a8)

  end subroutine ARQUIVO_escreve_data_hora

!-------------------------------------------------

  subroutine ARQUIVO_escreve_hora ( unit )

    integer,intent(in) :: unit ! arquivo
    integer*4    :: var(8)     ! data e hora
    character*2  :: aux1,aux2  ! auxiliares
    character*4  :: aux3       ! auxiliar
    character*8  :: hora       ! horário
    character*20 :: vardate,vartime,varzone ! data e hora
    character*50 :: aux		   ! auxiliar

    call date_and_time(vardate,vartime,varzone,var)

    write(aux,*) var(5)
    aux1 = trim(adjustl(aux))
    write(aux,*) var(6)
    aux2 = trim(adjustl(aux))
    write(aux,*) var(7)
    aux3 = trim(adjustl(aux))
    
	hora = trim(aux1)//':'//trim(aux2)//':'//aux3

    write(unit,1) hora
    1 format(5x,'Hora = ',a8)

  end subroutine ARQUIVO_escreve_hora

!-------------------------------------------------

  subroutine ARQUIVO_escreve_tempo_cpu ( tcpu_i, tcpu_f, unit )

    integer,intent(in) :: unit ! arquivo
    real*8,intent(in)  :: tcpu_i ! zero do cronômetro 
    real*8,intent(in)  :: tcpu_f ! tempo de processamento

    write(unit,1) tcpu_f - tcpu_i
    1 format(/,1pe15.5,' = tempo de processamento (s)',/)

  end subroutine ARQUIVO_escreve_tempo_cpu

!-------------------------------------------------

  subroutine ARQUIVO_fecha_frame

    integer*4 :: i ! controle

    i = setexitqq(qwin$exitnopersist)
  
  end subroutine ARQUIVO_fecha_frame

!-------------------------------------------------

  subroutine ARQUIVO_grava_campo_1D ( unit, nome, w, n_ini, n, x, T )

    integer,intent(in)             :: unit   ! identificador do arquivo
    character*(*),intent(in)       :: nome   ! nome do arquivo
    integer,intent(in)             :: w      ! freqüência de escrita; 0=não escreve
    integer,intent(in)             :: n_ini  ! ponto ou volume inicial de escrita
    integer,intent(in)             :: n      ! número de dados a escrever
    real*8,intent(in),dimension(:) :: x      ! coordenada espacial
    real*8,intent(in),dimension(:) :: T      ! variável a escrever
    integer :: i ! número do dado

    if ( w == 0 ) return

    call ARQUIVO_cria_arquivo ( unit, nome )

    do i = n_ini, n
       if ( i==n_ini .or. i==n .or. mod(i,w)==0 ) &
          write(unit,1) x(i), T(i)
    end do

    1 format(4(1pe25.15))

    close(unit)
 
  end subroutine ARQUIVO_grava_campo_1D

!-------------------------------------------------

  subroutine ARQUIVO_grava_campo_e_tubeira ( unit, nome, w, n_ini, n, x, T, xe, re )

    integer,intent(in)             :: unit   ! identificador do arquivo
    character*(*),intent(in)       :: nome   ! nome do arquivo
    integer,intent(in)             :: w      ! freqüência de escrita; 0=não escreve
    integer,intent(in)             :: n_ini  ! ponto ou volume inicial de escrita
    integer,intent(in)             :: n      ! número de dados a escrever
    real*8,intent(in),dimension(:) :: x      ! coordenada espacial
    real*8,intent(in),dimension(:) :: T      ! variável a escrever
    real*8,intent(in),dimension(:) :: xe     ! coordenada espacial da face da tubeira
    real*8,intent(in),dimension(:) :: re     ! raio da face da tubeira
    integer :: i ! número do dado

    real*8 :: T_min, T_max ! mínimo e máximo do campo
    real*8 :: r_min, r_max ! mínimo e máximo do raio

    if ( w == 0 ) return

    call ARQUIVO_cria_arquivo ( unit, nome )

    do i = n_ini, n
       if ( i==n_ini .or. i==n .or. mod(i,w)==0 ) &
          write(unit,1) x(i), T(i)
    end do

    1 format(4(1pe25.15))

    T_min = T(n_ini)
    T_max = T(n_ini)
    do i = n_ini, n
       if ( i==n_ini .or. i==n .or. mod(i,w)==0 ) then
          if ( T(i) <= T_min ) T_min = T(i)
          if ( T(i) >= T_max ) T_max = T(i)
       end if
    end do

    r_max = re(n_ini)
    do i = n_ini, n-1
       if ( i==n_ini .or. i==n-1 .or. mod(i,w)==0 ) then
          if ( re(i) >= r_max ) r_max = re(i)
       end if
    end do

    r_min = T_max + 5.0d-2 * ( T_max - T_min )

    ! escreve perfil da tubeira
    write(unit,1)
    do i = n_ini, n-1
       if ( i==n_ini .or. i==n-1 .or. mod(i,w)==0 ) &
          write(unit,1) xe(i), r_min+2.0d-1*(T_max-T_min)*(re(i)/r_max)
    end do

    ! escreve centro da tubeira
    write(unit,1)
    write(unit,1) xe(n_ini), r_min
    write(unit,1) xe(n-1),   r_min

    close(unit)
 
  end subroutine ARQUIVO_grava_campo_e_tubeira

!-------------------------------------------------

  subroutine ARQUIVO_le_dados ( unit )

    integer,      intent(in) :: unit         ! unidade do arquivo

    open ( unit, file = trim(nome_dados) )

    read ( unit, * ) caminho_programa
    read ( unit, * ) diretorio_trabalho
    read ( unit, * ) nome_caso
 
    close ( unit )

  end subroutine ARQUIVO_le_dados

!-------------------------------------------------

  subroutine ARQUIVO_le_inicio ( unit, nome )

    integer,      intent(in) :: unit ! unidade do arquivo
    character*(*),intent(in) :: nome ! nome do arquivo de dados de configuração do módulo

    open ( unit, file = trim(nome) )

    read ( unit, * ) nome_dados 
    read ( unit, * ) lista
    read ( unit, * ) le
    read ( unit, * ) copia

    close ( unit )

    if ( lista == 1 ) call ARQUIVO_notepad_abre_dado ( nome_dados )

    if ( le    == 1 ) call ARQUIVO_le_dados ( unit )

    call ARQUIVO_cria_diretorio ( unit )

    if ( copia == 1 ) call ARQUIVO_copia_arquivo ( nome_dados )

  end subroutine ARQUIVO_le_inicio

! -----------------------------------------------

  subroutine ARQUIVO_lista_arquivos

    read(99,*)
  
  end subroutine ARQUIVO_lista_arquivos

!-------------------------------------------------

  subroutine ARQUIVO_notepad_abre_dado ( nome_arquivo )

    character*(*),intent(in) :: nome_arquivo ! nome do arquivo

    comando = 'notepad '// trim(nome_arquivo)

    dos = systemqq ( comando )

  end subroutine ARQUIVO_notepad_abre_dado

!-------------------------------------------------

  subroutine ARQUIVO_notepad_abre_saida ( unit, nome_arquivo )

    integer,      intent(in) :: unit         ! unidade do arquivo

    character*(*),intent(in) :: nome_arquivo ! nome do arquivo

    open  ( unit, file = 'executa.bat' )

    write ( unit, * ) 'cd ' // trim(diretorio_trabalho)
    write ( unit, * ) 'notepad '//trim(nome_arquivo)

    close ( unit )

    dos = systemqq ( 'executa.bat' )

  end subroutine ARQUIVO_notepad_abre_saida

!-------------------------------------------------

  subroutine ARQUIVO_passa_caminho_programa ( caminho )

    character*(*) :: caminho ! nome do diretório onde está instalado o programa

    caminho = caminho_programa

  end subroutine ARQUIVO_passa_caminho_programa

!-------------------------------------------------

  subroutine ARQUIVO_passa_caso ( caso )

    character*(*) :: caso ! nome do caso

    caso = nome_caso

  end subroutine ARQUIVO_passa_caso

!-------------------------------------------------

  subroutine ARQUIVO_passa_data ( dia )

    character*12,intent(out) :: dia ! data
    integer*4    :: var(8)     ! data e hora
    character*2  :: aux1,aux2  ! auxiliares
    character*4  :: aux3       ! auxiliar
    character*20 :: vardate,vartime,varzone ! data e hora
    character*50 :: aux		   ! auxiliar

    call date_and_time(vardate,vartime,varzone,var)

    write(aux,*) var(3)
    aux1 = trim(adjustl(aux))
    write(aux,*) var(2)
    aux2 = trim(adjustl(aux))
    write(aux,*) var(1)
    aux3 = trim(adjustl(aux))

    dia = '('//trim(aux1)//'/'//trim(aux2)//'/'//aux3//')'

  end subroutine ARQUIVO_passa_data

!-------------------------------------------------

  subroutine ARQUIVO_passa_diretorio_trabalho ( trabalho )

    character*(*) :: trabalho ! nome do diretório para saídas

    trabalho = diretorio_trabalho

  end subroutine ARQUIVO_passa_diretorio_trabalho

!-------------------------------------------------

  subroutine ARQUIVO_passa_hora ( hora )

    character*8,intent(out) :: hora ! horário
    integer*4    :: var(8)     ! data e hora
    character*2  :: aux1,aux2  ! auxiliares
    character*4  :: aux3       ! auxiliar
    character*20 :: vardate,vartime,varzone ! data e hora
    character*50 :: aux		   ! auxiliar

    call date_and_time(vardate,vartime,varzone,var)

    write(aux,*) var(5)
    aux1 = trim(adjustl(aux))
    write(aux,*) var(6)
    aux2 = trim(adjustl(aux))
    write(aux,*) var(7)
    aux3 = trim(adjustl(aux))
    
	hora = trim(aux1)//':'//trim(aux2)//':'//aux3

  end subroutine ARQUIVO_passa_hora

!-------------------------------------------------

  subroutine ARQUIVO_remove_arquivo ( unit, nome_arquivo )

    integer,      intent(in) :: unit         ! unidade do arquivo

    character*(*),intent(in) :: nome_arquivo ! nome do arquivo

    open  ( unit, file = 'executa.bat' )

    write ( unit, * ) 'cd ' // trim(diretorio_trabalho)
    write ( unit, * ) 'erase '//trim(nome_arquivo)

    close ( unit )

    dos = systemqq ( 'executa.bat' )

  end subroutine ARQUIVO_remove_arquivo

!-------------------------------------------------

end module ARQUIVO