xref: /phasta/phSolver/common/rwvelb.f (revision 595995161822a203c8467e0e4a253d7bd7d6df32) !

        subroutine rwvelb (code,  q, ifail)
c
        use quadfilt
        include "common.h"
        include "mpif.h"
        include "auxmpi.h"
c
        character*4 code
        character*5  cname
        character*8  mach2
        character*20 fname1,  fmt1
        character*20 fname2
        character*60 syscmd
c
        dimension q(nfath,nflow)
       logical exlog
c
c.... -------------------------->  'in  '  <---------------------------
c


       if (code .eq. 'in  ') then

          numNden=zero           ! in case the read fails

          ifail=1
c
c.... open file
c
          fname1='bar.latest'
          fname1 = trim(fname1) // cname(myrank+1)
          inquire(file=fname1,exist=exlog)

          if(exlog)  then
          else
             open(unit=72,file='numstart.dat',status='old')
             read(72,*) irstart
             close(72)
             itmp = 1
             if (irstart .gt. 0) itmp = int(log10(float(irstart)))+1
             write (fmt1,"('(''bar.'',i',i1,',1x)')") itmp
             write (fname1,fmt1) irstart
             fname1 = trim(fname1) // cname(myrank+1)

             inquire(file=fname1,exist=exlog)
          endif

          write (*,*) 'Reading bar field file : ', fname1

          if(exlog) then        ! velb exists; open and use it
             open (unit=irstin, file=fname1, status='old',
     &            form='unformatted', err=877)

             read (irstin) mach2, nshg2, lstep2
             if((itwmod.gt.0) .or. (irscale.ge.0)) then
                read (irstin,err=877,end=877) q
                write(*,*) "velb found and read properly"
                ifail=0         ! i.e. I didn't fail
             endif
             if((nsonmax.eq.1) .and. (iLES.gt.0)) then
                read (irstin,err=888,end=888) numNDen
                write(*,*) "numDen found and read properly",myrank+1
             endif
 888         continue
 877         continue
             close (irstin)
          endif                 ! if bar field file exists

          return
       endif
c
c.... -------------------------->  'out '  <---------------------------
c
      if (code .eq. 'out ') then

         itmp = 1
         if (lstep .gt. 0) itmp = int(log10(float(lstep)))+1
         write (fmt1,"('(''bar.'',i',i1,',1x)')") itmp
         write (fname1,fmt1) lstep
          fname1 = trim(fname1) // cname(myrank+1)
c
         open (unit=irstou, file=fname1, status='unknown',
     &        form='unformatted', err=996)

         write (irstou) machin, nshg, lstep
         if((itwmod.gt.0) .or. (irscale.ge.0)) then
            write (irstou) q
         endif
         if((nsonmax.eq.1) .and. (iLES.gt.0)) then
            write (irstou) numNden
         endif
         close (irstou)

         call MPI_BARRIER(MPI_COMM_WORLD,ierr)
c
c update links of "latest"
c
         fname2='bar.latest'
         fname2 = trim(fname2) // cname(myrank+1)
c         syscmd = 'ln -sf '//trim(fname1)// ' ' //fname2
c         write(*,*) syscmd
c         call system(syscmd)

         return
      endif
c
c.... ---------------------->  Error Handling  <-----------------------
c
c.... Error handling
c
        call error ('velb  ',code//'    ',0)
c
c.... file error handling
c
995     call error ('velb  ','opening ', irstin)
996     call error ('velb  ','opening ', irstou)
c
c.... end
c
        end