1 subroutine proces 2c 3c---------------------------------------------------------------------- 4c 5c This subroutine generates the problem data and calls the solution 6c driver. 7c 8c 9c Zdenek Johan, Winter 1991. (Fortran 90) 10c---------------------------------------------------------------------- 11c 12 use readarrays ! used to access x, iper, ilwork 13 use turbsa ! used to access d2wall 14 include "common.h" 15 include "mpif.h" 16c 17c arrays in the following 2 lines are now dimensioned in readnblk 18c dimension x(numnp,nsd) 19c dimension iper(nshg), ilwork(nlwork) 20c 21 dimension y(nshg,ndof), 22 & iBC(nshg), 23 & BC(nshg,ndofBC), 24 & ac(nshg,ndof) 25c 26c.... shape function declarations 27c 28 dimension shp(MAXTOP,maxsh,MAXQPT), 29 & shgl(MAXTOP,nsd,maxsh,MAXQPT), 30 & shpb(MAXTOP,maxsh,MAXQPT), 31 & shglb(MAXTOP,nsd,maxsh,MAXQPT) 32c 33c stuff for dynamic model s.w.avg and wall model 34c 35c dimension ifath(numnp), velbar(nfath,nflow), 36c & nsons(nfath) 37 38 dimension velbar(nfath,nflow) 39c 40c stuff to interpolate profiles at inlet 41c 42 real*8 bcinterp(100,ndof+1),interp_mask(ndof) 43 logical exlog 44 45c if ((irscale .ge. 0) .and. (myrank.eq.master)) then 46c call setSPEBC(numnp, point2nfath, nsonmax) 47c endif 48c 49c.... generate the geometry and boundary conditions data 50c 51 call gendat (y, ac, point2x, 52 & iBC, BC, 53 & point2iper, point2ilwork, shp, 54 & shgl, shpb, shglb, 55 & point2ifath, velbar, point2nsons ) 56 call setper(nshg) 57 call perprep(iBC,point2iper,nshg) 58 if (iLES/10 .eq. 1) then 59 call keeplhsG ! Allocating space for the mass (Gram) matrix to be 60 ! used for projection filtering and reconstruction 61 ! of the strain rate tensor. 62 63 call setrls ! Allocating space for the resolved Leonard stresses 64c See bardmc.f 65 endif 66c 67c.... time averaged statistics 68c 69 if (ioform .eq. 2) then 70 call initStats(point2x, iBC, point2iper, point2ilwork) 71 endif 72c 73c.... RANS turbulence model 74c 75 if (iRANS .lt. 0) then 76 call initTurb( point2x ) 77 endif 78c 79c.... p vs. Q boundary 80c 81 call initNABI( point2x, shpb ) 82c 83c.... check for execution mode 84c 85 if (iexec .eq. 0) then 86 lstep = 0 87 call restar ('out ', y ,ac) 88 return 89 endif 90c 91c.... initialize AutoSponge 92c 93 if(matflg(5,1).ge.4) then ! cool case (sponge) 94 call initSponge( y,point2x) 95 endif 96c 97c 98c.... adjust BC's to interpolate from file 99c 100 101 inquire(file="inlet.dat",exist=exlog) 102 if(exlog) then 103 open (unit=654,file="inlet.dat",status="old") 104 read(654,*) ninterp,ibcmatch,(interp_mask(j),j=1,ndof) 105 do i=1,ninterp 106 read(654,*) (bcinterp(i,j),j=1,ndof+1) ! distance to wall+ 107 ! ndof but note order of BC's 108 ! p,t,u,v,w,scalars. Also note that must be in 109 ! increasing distance from the wall order. 110 111 enddo 112 do i=1,nshg ! only correct for linears at this time 113 if(mod(iBC(i),1024).eq.ibcmatch) then 114 iupper=0 115 do j=2,ninterp 116 if(bcinterp(j,1).gt.d2wall(i)) then !bound found 117 xi=(d2wall(i)-bcinterp(j-1,1))/ 118 & (bcinterp(j,1)-bcinterp(j-1,1)) 119 iupper=j 120 exit 121 endif 122 enddo 123 if(iupper.eq.0) then 124 write(*,*) 'failure in finterp, ynint=',d2wall(i) 125 stop 126 endif 127 if(interp_mask(1).ne.zero) then 128 BC(i,1)=(xi*bcinterp(iupper,2) 129 & +(one-xi)*bcinterp(iupper-1,2))*interp_mask(1) 130 endif 131 if(interp_mask(2).ne.zero) then 132 BC(i,2)=(xi*bcinterp(iupper,3) 133 & +(one-xi)*bcinterp(iupper-1,3))*interp_mask(2) 134 endif 135 if(interp_mask(3).ne.zero) then 136 BC(i,3)=(xi*bcinterp(iupper,4) 137 & +(one-xi)*bcinterp(iupper-1,4))*interp_mask(3) 138 endif 139 if(interp_masK(4).ne.zero) then 140 BC(i,4)=(xi*bcinterp(iupper,5) 141 & +(one-xi)*bcinterp(iupper-1,5))*interp_mask(4) 142 endif 143 if(interp_mask(5).ne.zero) then 144 BC(i,5)=(xi*bcinterp(iupper,6) 145 & +(one-xi)*bcinterp(iupper-1,6))*interp_mask(5) 146 endif 147 if(interp_mask(6).ne.zero) then 148 BC(i,7)=(xi*bcinterp(iupper,7) 149 & +(one-xi)*bcinterp(iupper-1,7))*interp_mask(6) 150 endif 151 if(interp_mask(7).ne.zero) then 152 BC(i,8)=(xi*bcinterp(iupper,8) 153 & +(one-xi)*bcinterp(iupper-1,8))*interp_mask(7) 154 endif 155 endif 156 enddo 157 endif 158c$$$$$$$$$$$$$$$$$$$$ 159 160c 161c 162c.... call the semi-discrete predictor multi-corrector iterative driver 163c 164 call itrdrv (y, ac, 165 & uold, point2x, 166 & iBC, BC, 167 & point2iper, point2ilwork, shp, 168 & shgl, shpb, shglb, 169 & point2ifath, velbar, point2nsons ) 170c 171c.... return 172c 173c 174c.... stop CPU-timer 175c 176CAD call timer ('End ') 177c 178c.... close echo file 179c 180 181!MR CHANGE 182 if (numpe > 1) call MPI_BARRIER(MPI_COMM_WORLD, ierr) 183 if(myrank.eq.0) then 184 write(*,*) 'process - before closing iecho' 185 endif 186!MR CHANGE END 187 188 close (iecho) 189 190!MR CHANGE 191 if (numpe > 1) call MPI_BARRIER(MPI_COMM_WORLD, ierr) 192 if(myrank.eq.0) then 193 write(*,*) 'process - after closing iecho' 194 endif 195!MR CHANGE END 196 197 198c 199c.... end of the program 200c 201CAD write(6,*) 'Life: ', second(0) - ttim(100) 202 deallocate(point2iper) 203 if(numpe.gt.1) then 204 call Dctypes(point2ilwork(1)) 205 deallocate(point2ilwork) 206 endif 207 deallocate(point2x) 208 209 if((irscale.ge.0).or. ((iLES .lt. 20) .and. (iLES.gt.0)) 210 & .or. (itwmod.gt.0) ) then ! don't forget same 211 ! conditional in 212 ! readnblk2.f 213 deallocate(point2nsons) 214 deallocate(point2ifath) 215 endif 216 return 217 end 218 219 220