1 subroutine rwvelb (code, q, ifail) 2c 3 use quadfilt 4 include "common.h" 5 include "mpif.h" 6 include "auxmpi.h" 7c 8 character*4 code 9 character*5 cname 10 character*8 mach2 11 character*20 fname1, fmt1 12 character*20 fname2 13 character*60 syscmd 14c 15 dimension q(nfath,nflow) 16 logical exlog 17c 18c.... --------------------------> 'in ' <--------------------------- 19c 20 21 22 if (code .eq. 'in ') then 23 24 numNden=zero ! in case the read fails 25 26 ifail=1 27c 28c.... open file 29c 30 fname1='bar.latest' 31 fname1 = trim(fname1) // cname(myrank+1) 32 inquire(file=fname1,exist=exlog) 33 34 if(exlog) then 35 else 36 open(unit=72,file='numstart.dat',status='old') 37 read(72,*) irstart 38 close(72) 39 itmp = 1 40 if (irstart .gt. 0) itmp = int(log10(float(irstart)))+1 41 write (fmt1,"('(''bar.'',i',i1,',1x)')") itmp 42 write (fname1,fmt1) irstart 43 fname1 = trim(fname1) // cname(myrank+1) 44 45 inquire(file=fname1,exist=exlog) 46 endif 47 48 write (*,*) 'Reading bar field file : ', fname1 49 50 if(exlog) then ! velb exists; open and use it 51 open (unit=irstin, file=fname1, status='old', 52 & form='unformatted', err=877) 53 54 read (irstin) mach2, nshg2, lstep2 55 if((itwmod.gt.0) .or. (irscale.ge.0)) then 56 read (irstin,err=877,end=877) q 57 write(*,*) "velb found and read properly" 58 ifail=0 ! i.e. I didn't fail 59 endif 60 if((nsonmax.eq.1) .and. (iLES.gt.0)) then 61 read (irstin,err=888,end=888) numNDen 62 write(*,*) "numDen found and read properly",myrank+1 63 endif 64 888 continue 65 877 continue 66 close (irstin) 67 endif ! if bar field file exists 68 69 return 70 endif 71c 72c.... --------------------------> 'out ' <--------------------------- 73c 74 if (code .eq. 'out ') then 75 76 itmp = 1 77 if (lstep .gt. 0) itmp = int(log10(float(lstep)))+1 78 write (fmt1,"('(''bar.'',i',i1,',1x)')") itmp 79 write (fname1,fmt1) lstep 80 fname1 = trim(fname1) // cname(myrank+1) 81c 82 open (unit=irstou, file=fname1, status='unknown', 83 & form='unformatted', err=996) 84 85 write (irstou) machin, nshg, lstep 86 if((itwmod.gt.0) .or. (irscale.ge.0)) then 87 write (irstou) q 88 endif 89 if((nsonmax.eq.1) .and. (iLES.gt.0)) then 90 write (irstou) numNden 91 endif 92 close (irstou) 93 94 call MPI_BARRIER(MPI_COMM_WORLD,ierr) 95c 96c update links of "latest" 97c 98 fname2='bar.latest' 99 fname2 = trim(fname2) // cname(myrank+1) 100c syscmd = 'ln -sf '//trim(fname1)// ' ' //fname2 101c write(*,*) syscmd 102c call system(syscmd) 103 104 return 105 endif 106c 107c.... ----------------------> Error Handling <----------------------- 108c 109c.... Error handling 110c 111 call error ('velb ',code//' ',0) 112c 113c.... file error handling 114c 115995 call error ('velb ','opening ', irstin) 116996 call error ('velb ','opening ', irstou) 117c 118c.... end 119c 120 end 121