m_parameters.f90 Source File


Source Code

module m_parameters

     use, intrinsic :: iso_fortran_env, only: real64
     use m_openmpi

  implicit none

     integer :: nxp,nyp,nzp

     real(real64) :: hxp,hyp,hzp

     real(real64) :: l_0

     integer :: startnum,endnum,skipnum,shiftnum

     real(real64) :: scp,prp,lep,vis0p,rod

     real(real64) :: prof_wr,min_wr,min_fsd,min_c,refwr

     real(real64) :: pre,ac,bc,c_cut,c_ref

     integer :: syp,eyp,twod

     real(real64) :: SL_u

     integer :: omitnum

     integer, allocatable :: omit_t(:,:)

     integer, allocatable :: file_dist(:)

     integer, allocatable :: export_offset(:)

     real(real64), parameter :: pi=3.14159265358979323846_real64
     real(real64), parameter :: me=1.00e-20_real64

contains

logical function to_omit(num)

    integer, intent(in) :: num

    integer :: i

    to_omit=.false.

    do i=1,omitnum
      if (num.ge.omit_t(i,1).and.num.le.omit_t(i,2)) then
        to_omit=.true.
      endif
    enddo

end function to_omit

subroutine read_intro

      character(LEN=10) :: cdum

      integer :: ierr,i

      integer :: first_file

      integer :: file_count

      real*8 :: tmp1, tmp2, tmp3

      open (100, FILE='post-edge-cold-bc-hybrid-intro')
      open (101, FILE='otape')

      read (100,*) cdum,l_0
      write(101,*) cdum,l_0
      read (100,*) cdum,startnum
      write(101,*) cdum,startnum
      read (100,*) cdum,endnum
      write(101,*) cdum,endnum
      read (100,*) cdum,skipnum
      write(101,*) cdum,skipnum
      read (100,*) cdum,shiftnum
      write(101,*) cdum,shiftnum
      read (100,*) cdum,vis0p
      write(101,*) cdum,vis0p
      read (100,*) cdum,scp
      write(101,*) cdum,scp
      read (100,*) cdum,lep
      write(101,*) cdum,lep
      read (100,*) cdum,min_wr
      write(101,*) cdum,min_wr
      read (100,*) cdum,prof_wr
      write(101,*) cdum,prof_wr
      read (100,*) cdum,min_fsd
      write(101,*) cdum,min_fsd
      read (100,*) cdum,min_c
      write(101,*) cdum,min_c
      read (100,*) cdum,pre
      write(101,*) cdum,pre
      read (100,*) cdum,ac
      write(101,*) cdum,ac
      read (100,*) cdum,bc
      write(101,*) cdum,bc
      read (100,*) cdum,c_cut
      write(101,*) cdum,c_cut
      read (100,*) cdum,c_ref
      write(101,*) cdum,c_ref
      read (100,*) cdum,syp
      write(101,*) cdum,syp
      read (100,*) cdum,eyp
      write(101,*) cdum,eyp
      read (100,*) cdum,SL_u
      write(101,*) cdum,SL_u
      read (100,*) cdum,omitnum
      write(101,*) cdum,omitnum

      if (omitnum.gt.0) THEN
       allocate (omit_t(omitnum,2), stat=ierr)
       do i=1,omitnum
        read (100,*) cdum,omit_t(i,1)  ! begining fullsave number
        write(101,*) cdum,omit_t(i,1)
        read (100,*) cdum,omit_t(i,2)  ! ending fullsave number
        write(101,*) cdum,omit_t(i,2)
       enddo
      endif

      prp=scp/lep

      refwr=pre*1.*exp(-ac/(1.+bc*c_ref))   ! wrate at c_ref

      rod=vis0p/prp/lep ! vis0p dynamic viscosity, rod= density*mass diffusivity = rho*D

      close (100)
      close (101)


      allocate (file_dist(startnum:endnum), stat=ierr)
      if (ierr /= 0) then
          write(0,*) "Error: allocation of file_dist failed on process", myid
          call MPI_ABORT(MPI_COMM_TASK, 1, mpi_err)
      end if
      allocate (export_offset(startnum:endnum), stat=ierr)
      if (ierr /= 0) then
          write(0,*) "Error: allocation of export_offset failed on process", myid
          call MPI_ABORT(MPI_COMM_TASK, 1, mpi_err)
      end if

      file_count = 0

      distloop: DO i=startnum,endnum,skipnum

        IF ( .not. to_omit(i) ) THEN

          file_dist(i) = mod(file_count, numprocs)
          export_offset(i) = file_count

          file_count = file_count + 1

        ENDIF

      ENDDO distloop


      first_file = startnum

      fileloop: DO i=startnum,endnum,skipnum

        IF ( .not. to_omit(i) ) THEN

          first_file = i

          exit fileloop

        ENDIF

      ENDDO fileloop

      OPEN(first_file,FORM='unformatted',STATUS='unknown')

      READ(first_file) tmp1,nxp,nyp,nzp,tmp2,tmp3

      CLOSE(first_file)

      hyp=l_0*pi/REAL(nyp)
      hxp=hyp
      hzp=hyp


end subroutine read_intro

end module m_parameters