c file: 'field.for' subroutine pltfld c + + + PURPOSE + + + c Draw an ASCII graphics representation of the field simulation regions, c subregions, accounting regions, and barriers. c author: J. "Dudley" Hunkins c date received: 6/25/95 c + + + KEY WORDS + + + c dudley tyrannosaurus beer c + + + GLOBAL COMMON BLOCKS + + + *$noereference include 'p1werm.inc' include 'm1subr.inc' include 'm1geo.inc' c + + + LOCAL COMMON BLOCKS + + + c$INCLUDE:'main/main.inc' *$reference c + + + LOCAL DEFINITIONS + + + integer loop,pnt,bar real amxdud(2,50) real minx2,miny2,x2,y2 real minx,miny real maxx,maxy real scale integer c,r,offset character*1 field(80,40) common /pfmin/ minx,miny common /pfmax/ maxx,maxy common /pfscale/ scale,c,r,offset common /pffield/ field c initialize things call pfinit() c read the field definitions c call pfread() c determine the plotting parameters call pfparm() c plot the amxsim into the field array call pfplot(amxsim,':') c plot the subregions do 330 loop=1,nsubr c keep track of the min x/y coordinate minx2=amxsr(1,1,loop) miny2=amxsr(2,1,loop) pnt=1 c put the 3d array value into the 2d array 310 amxdud(1,pnt)=amxsr(1,pnt,loop) amxdud(2,pnt)=amxsr(2,pnt,loop) if ((amxdud(1,pnt) .eq. -1) .and. & (amxdud(2,pnt) .eq. -1)) go to 320 c do we have new min values? if (amxdud(1,pnt) .lt. minx2) minx2=amxdud(1,pnt) if (amxdud(2,pnt) .lt. miny2) miny2=amxdud(2,pnt) if (pnt .eq. 2) goto 320 pnt=pnt+1 go to 310 c plot the subregion 320 call pfplot(amxdud,'+') c determine the location of the subregion label number x2=(minx2-minx)*scale*2+offset+2 x2=x2+mod(int(x2),2) y2=(r-(miny2-miny)*scale)-1 c place the subregion number in the lower left area of the region field(int(x2),int(y2))=char(loop+48) 330 continue c plot the accounting regions do 360 loop=1,nacctr pnt=1 340 amxdud(1,pnt)=amxar(1,pnt,loop) amxdud(2,pnt)=amxar(2,pnt,loop) if ((amxdud(1,pnt) .eq. -1) .and. & (amxdud(2,pnt) .eq. -1)) go to 350 if (pnt .eq.2) goto 350 pnt=pnt+1 go to 340 350 call pfplot(amxdud,'x') 360 continue c plot the barriers do 400 loop=1,nsubr do 390 bar=1,nbar(loop) pnt=1 370 amxdud(1,pnt)=amxbar(1,pnt,loop,bar) amxdud(2,pnt)=amxbar(2,pnt,loop,bar) if ((amxdud(1,pnt) .eq. -1) .and. & (amxdud(2,pnt) .eq. -1)) go to 380 if (pnt .eq. 2) goto 380 pnt=pnt+1 go to 370 380 call pfplot(amxdud,'*') 390 continue 400 continue c display the "ascii graphics" representation of the field call pfshow() return end c ------------------------------------------------------------------------- subroutine pfinit c + + + PURPOSE + + + c Clear the field array and set the number of characters that the c field output is restricted to. c author: J. "Dudley" Hunkins c date received: 6/25/95 c + + + KEY WORDS + + + c + + + LOCAL DEFINITIONS + + + integer x,y character*1 field(80,40) real scale integer c,r,offset c common blocks common /pffield/ field common /pfscale/ scale,c,r,offset do 5 x=1,80 do 15 y=1,40 field(x,y)=' ' 15 continue 5 continue scale=0 c=30 r=40 offset=10 do 20 x=1,8 field(offset-x,r-x)='.' 20 continue field(offset-9,r-8)='N' field(offset-8,r-8)='O' field(offset-7,r-8)='R' field(offset-6,r-8)='T' field(offset-5,r-8)='H' field(offset-4,r-5)='-' field(offset-3,r-5)='-' field(offset-2,r-5)='-' field(offset-1,r-5)='>' return end c ------------------------------------------------------------------------- c subroutine pfread c This subroutine loads in the x,y values that define the physical c regions. This subroutine should be removed once the rest of the c plotting stuff is linked into the model. c field.dat must be in the directory that you run the executable. c Use the field.dat that I made. If you lose it, you must construct c it based on the order things are read in below. c read the number of subregions c author: J. "Dudley" Hunkins c date received: 6/25/95 c + + + KEY WORDS + + + c c + + + GLOBAL COMMON BLOCKS + + + c$INCLUDE:'p1werm.inc' c$INCLUDE:'m1subr.inc' c$INCLUDE:'m1geo.inc' c + + + LOCAL COMMON BLOCKS + + + c$INCLUDE:'main/main.inc' c + + + LOCAL DEFINITIONS + + + c character*79 line c integer loop,pnt,sr,bar,ar c integer nsr,nacctr c integer nbps(50) c real amxsim(2,50) c c real amxsr(2,50,4) c real amxbar(2,50,4,4) c real amxar(2,4,4) c common blocks c common /pfnums/ nsr,nacctr,nbps c common /pfsim/ amxsim c common /pfamx/ amxsr,amxbar,amxar c open(unit=10,file='field.dat') c20 read(10,'(a)',end=300) line c lines that begin with the hash or are blank, will be ignored c if ((line(1:1) .eq. '#') .or. (line .eq. '')) go to 20 c read(line,*) nsr c read the number of barriers per subregion c do 40 loop=1,nsr c30 read(10,'(a)',end=300) line c if ((line(1:1) .eq. '#') .or. (line .eq. '')) go to 30 c read(line,*) nbps(loop) c40 continue c read the number of accounting regions c50 read(10,'(a)',end=300) line c if ((line(1:1) .eq. '#') .or. (line .eq. '')) go to 50 c read(line,*) nacctr c c read in the simulation region c pnt=1 c60 read(10,'(a)',end=300) line c if ((line(1:1) .eq. '#') .or. (line .eq. '')) go to 60 c read(line,*) amxsim(1,pnt),amxsim(2,pnt) c pnt=pnt+1 c65 read(10,'(a)',end=300) line c if ((line(1:1) .eq. '#') .or. (line .eq. '')) go to 65 c read(line,*) amxsim(1,pnt),amxsim(2,pnt) c if ((amxsim(1,pnt) .eq. -1) .and. (amxsim(2,pnt) .eq. -1)) c & go to 70 c pnt=pnt+1 c go to 65 c c read in the subregions c70 do 120 sr=1,nsr c pnt=1 c80 read(10,'(a)',end=300) line c if ((line(1:1) .eq. '#') .or. (line .eq. '')) go to 80 c read(line,*) amxsr(1,pnt,sr),amxsr(2,pnt,sr) c if ((amxsr(1,pnt,sr) .eq. -1) .and. (amxsr(2,pnt,sr) .eq. -1)) c & go to 90 c pnt=pnt+1 c go to 80 c c90 if (nbps(sr) .eq. 0) go to 120 c read in barriers for the subregion c pnt=1 c do 110 bar=1,nbps(sr) c100 read(10,'(a)',end=300) line c if ((line(1:1) .eq. '#') .or. (line .eq. '')) go to 100 c read(line,*) amxbar(1,pnt,sr,bar),amxbar(2,pnt,sr,bar) c if ((amxbar(1,pnt,sr,bar) .eq. -1) .and. c & (amxbar(2,pnt,sr,bar) .eq. -1)) go to 110 c pnt=pnt+1 c go to 100 c110 continue c120 continue c c read in accounting regions c pnt=1 c do 140 ar=1,nacctr c130 read(10,'(a)',end=300) line c if ((line(1:1) .eq. '#') .or. (line .eq. '')) go to 130 c read(line,*) amxar(1,pnt,ar),amxar(2,pnt,ar) c if ((amxar(1,pnt,ar) .eq. -1) .and. c & (amxar(2,pnt,ar) .eq. -1)) go to 140 c pnt=pnt+1 c go to 130 c140 continue c 300 close(10) c return c end c ------------------------------------------------------------------------- subroutine pfparm c + + + PURPOSE + + + c This subroutine finds the x,y boundaries of the simulation c region, which are used to find the parameters that scale the c plot onto the page. c author: J. "Dudley" Hunkins c date received: 6/25/95 c + + + KEY WORDS + + + c c + + + GLOBAL COMMON BLOCKS + + + *$noereference include 'p1werm.inc' c$INCLUDE:'m1subr.inc' include 'm1geo.inc' c + + + LOCAL COMMON BLOCKS + + + c$INCLUDE:'main/main.inc' *$reference c + + + LOCAL DEFINITIONS + + + integer pnt real x,y real minx,miny real maxx,maxy real scale integer c,r, offset c real amxsim(2,50) common /pfmin/ minx,miny common /pfmax/ maxx,maxy common /pfscale/ scale,c,r, offset c common /pfsim/ amxsim c find max's and min's (for the simulation region) pnt=1 c We must assume the first x,y pair are each the min and max maxx=amxsim(1,pnt) minx=amxsim(1,pnt) maxy=amxsim(2,pnt) miny=amxsim(2,pnt) c if x and y are -1, we've reached the end of the coordinate list 400 if ((amxsim(1,pnt) .eq. -1) .and. (amxsim(2,pnt) .eq. -1)) & go to 410 c check to see if the current x/y's are the new min/max if (amxsim(1,pnt) .gt. maxx) maxx=amxsim(1,pnt) if (amxsim(1,pnt) .lt. minx) minx=amxsim(1,pnt) if (amxsim(2,pnt) .gt. maxy) maxy=amxsim(2,pnt) if (amxsim(2,pnt) .lt. miny) miny=amxsim(2,pnt) if (pnt .eq. 2) goto 410 c next point pnt=pnt+1 go to 400 c compute the graph parameters c x/y is the size of the field 410 x=maxx-minx+1 y=maxy-miny+1 c "scale" is how much the field should be reduced/enlarged to fit c the page. To retain the aspect ratio, the scale is the same for c both the x and y directions. Furthermore, the direction that needs c the most scaling determines the overall scaling factor. if (r/y .lt. c/x) then scale=r/y else scale=c/x endif return end c ------------------------------------------------------------------------- subroutine pfplot (blah,symbol) c + + + PURPOSE + + + c This subroutine "connects the dots" of a coordinate list by c placing the characters "symbol" in the field array. The heart c of this routine is a "line drawing" algorithm. c + + + LOCAL DEFINITIONS + + + character*1 symbol real blah(2,50) real x1,y1,x2,y2 real step c common blocks real minx,miny real scale integer c,r,offset character*1 field(80,40) common /pfmin/ minx,miny common /pfscale/ scale,c,r,offset common /pffield/ field if (blah(1,1) .lt. blah(1,2)) then x1=blah(1,1) x2=blah(1,2) else x1=blah(1,2) x2=blah(1,1) endif if (blah(2,1) .lt. blah(2,2)) then y1=blah(2,1) y2=blah(2,2) else y1=blah(2,2) y2=blah(2,1) endif c x1 and x2 should not be equal c the same goes for y1 and y2 c maybe we should test for this? is there really any harm though? c determine which position in the array corresponds to the point. c minx is subtracted from the x value to flush it on the left side c of the "page" (array). The x value is then scaled (by multiplying c by the scale value) and multiplied by 2 since the spacing between c lines on the output is about the same as the spacing between every c other column. Add 1 to offset correctly into the fortran array. x1=(x1-minx)*scale*2+offset x1=x1+mod(int(x1),2) x2=(x2-minx)*scale*2+offset x2=x2+mod(int(x2),2) c the y value is computed in a similar manner to the x value, except c the scale is not doubled, and the value is inverted. The inversion c is because 0,0 is the upper left in the array (when output) and c the 0,0 field coordinate is the lower left. y1=(r-(y1-miny)*scale) y2=(r-(y2-miny)*scale) c plot left side step=0 304 field(int(x1),int(y1-step))=symbol step=step+1 if (y1-step .ge. y2) goto 304 c plot bottom side step=0 307 field(int(x1+step),int(y2))=symbol step=step+2 if (x1+step .le. x2+1) goto 307 c plot right side step=0 306 field(int(x2),int(y1-step))=symbol step=step+1 if (y1-step .ge. y2) goto 306 c plot top side step=0 305 field(int(x2-step),int(y1))=symbol step=step+2 if (x2-step .ge. x1-1) goto 305 600 return end c ------------------------------------------------------------------------- subroutine pfshow c This subroutine displays the field array which should hold the c ascii representation of the field regions' geometries. c local variables integer c,r c common blocks character*1 field(80,40) common /pffield/ field 500 do 510 r=1,40 write(2,*) (field(c,r),c=1,77) 510 continue return end