c subroutine axes4 c c c PROG NAME: AXES4.rat c c DATE OF FIRST VERSION: 9-Feb-83 c DATE OF CURRENT VERSION: 21-Jun-83 c c PURPOSE: PLTFIL routine to plot axis lines and tick c marks, grid lines, annotations and axis labels. c c USAGE: call AXES4 c c SUBROUTINES REQUIRED: IMAG,AXLINE,AXGRID,AXANNO,ANNLEN,IDIGTS, c IRAM,OUTPUT,NEWPEN,TEXT c c PROGRAMMER: Eric Javel / Matt Prucka c c********************************************************************* c c Common block for PLT parameters c real*8prmnam,txtnam,keywrd bytexlabel,ylabel,rlabel,xfmt,yfmt,rfmt,msg,filonm(14) bytefilinm(40) logical*1dataon,pltfnd,msgflg,finflg,modflg,conton,axflg,newpag, & ecflg,typerr,dbflg c common /params/xmin,xmax,xint,xcycle,xpct,xlen,xllc,ymin,ymax, & yint,ycycle,ypct,ylen,yllc,rmin,rmax,rint,rcycle,rpct,pltype, & typlin,pltlin,symnum,sizsym,solid,sizann,wtlnan,xanlab,yanlab, & ranlab,yhor,grid,sizlab,wtlnlb,ticmrk,shade,echo,wtlnax,openax, & sizmsg,wtlnms,xmsg,ymsg,angmsg,datmsg,sizfac,smooth,header,sort, & unused(1) common /flags/dataon,pltfnd,msgflg,finflg,modflg,conton,axflg, & newpag,ecflg,typerr,dbflg common /names/prmnam(50),txtnam(6),keywrd(25),filinm,filonm common /text/xlabel(52),ylabel(52),rlabel(52),xfmt(6),yfmt(6), & rfmt(6),msg(256) common /misc/ifrom,ito,inow,ipage,model,lunin,lunout c common /axes/rxmin,rxmax,rymin,rymax,rxlen,rylen,rxllc,ryllc, & pxmin,pxmax,pymin,pymax,pxlen,pylen,pxllc,pyllc common /size/tiklen,hitann,hitlab,hitsym,hitmsg,iaxlnw,igrlnw, & ianlnw,ilblnw,ipllnw,imslnw,avgaxl common /msks/ msk1,msk2,msk3,msk4,msk5 external len common /ppep1/ ix1,iy1,ix2,iy2,iscan,nscan,nband,nips,nip0, nipm1, & lynes,nibsx,msglvl,xdots,ydots,pref(2), rorg(2),port(2,2),iend(4) & ,almt,fact,jpen,xoff, xfac,yoff,yfac,nbits,nbitm1,nbytes,nbytm1, & msk,lmsk c c--------------------------------------------------------------------- c c Set current axis parameters in common /AXES/ rxmin = xmin pxmin = xmin rxmax = xmax pxmax = xmax rymin = ymin pymin = ymin rymax = ymax pymax = ymax rxlen = xlen pxlen = xlen rylen = ylen pylen = ylen rxllc = xllc pxllc = xllc ryllc = yllc pyllc = yllc c Process log axis: c c 1. Correct minimum and maximum values if not provided c 2. Determine imaginary minimum and maximum if the ones provided c aren't a power of ten c 3. Compute correct number of cycles, based on minimum and maximum c 4. Compute parameters for imaginary log axis if(.not.(xcycle .ne. 0.))goto 23000 if(.not.(rxmin .ne. 0.0 .and. rxmax .eq. 0.0))goto 23002 rxmax=rxmin*(10.**aint(xcycle)) 23002 continue if(.not.(rxmax .ne. 0.0 .and. rxmin .eq. 0.0))goto 23004 rxmin=rxmax/(10.**aint(xcycle)) 23004 continue xcycle = alog10 (rxmax/rxmin) call imag (rxmin,rxmax,rxlen,rxllc,pxmin,pxmax,pxlen,pxllc, & xpct) 23000 continue if(.not.(ycycle .ne. 0.))goto 23006 if(.not.(rymin .ne. 0.0 .and. rymax .eq. 0.0))goto 23008 rymax=rymin*(10.**aint(ycycle)) 23008 continue if(.not.(rymax .ne. 0.0 .and. rymin .eq. 0.0))goto 23010 rymin=rymax/(10.**aint(ycycle)) 23010 continue ycycle = alog10 (rymax/rymin) call imag (rymin,rymax,rylen,ryllc,pymin,pymax,pylen,pyllc, & ypct) 23006 continue if(.not.(rcycle .ne. 0. .and. (rmin.ne.0. .or. rmax.ne.0.) )) & goto 23012 if(.not.(rmin .ne. 0. .and. rmax .eq. 0.))goto 23014 rmax=rmin*(10.**aint(rcycle)) 23014 continue if(.not.(rmax .ne. 0. .and. rmin .eq. 0.))goto 23016 rmin=rmax/(10.**aint(rcycle)) 23016 continue rcycle = alog10 (rmax/rmin) c-------------------------------------------------------------------------- c Process AXIS LINES c-------------------------------------------------------------------------- 23012 continue if(.not.(dbflg))goto 23018 type *,' axes4: iaxlnw,ianlnw,igrlnw,ilblnw',iaxlnw,ianlnw, & igrlnw,ilblnw 23018 continue if(.not.(iaxlnw.ne.0))goto 23020 c Set axis line weight call newpen (iaxlnw) c left axis call axline (2) c bottom axis call axline (1) c right axis if(.not.(openax.eq.0. .or. rmin.ne.0. .or. rmax.ne.0.))goto 230 & 22 call axline (4) c top axis 23022 continue if(.not.(openax .eq. 0.))goto 23024 call axline (3) 23024 continue c-------------------------------------------------------------------------- c Process GRID LINES c-------------------------------------------------------------------------- c See if a grid exists 23020 continue if(.not.(igrlnw.ne.0))goto 23026 if(.not.(grid.ne.0.0 .and. openax.eq.0. .and. rmin.eq.0. .and. & rmax.eq.0.))goto 23028 c Set the grid line weight call newpen (igrlnw) c Do the grid call axgrid (1) call axgrid (2) c-------------------------------------------------------------------------- c Process ANNOTATIONS c-------------------------------------------------------------------------- 23028 continue 23026 continue if(.not.(ianlnw.ne.0))goto 23030 call newpen (ianlnw) c Bottom segment if(.not.(xanlab .ge. 0.))goto 23032 c inward tick annpos = ryllc - hitann - tiklen/2. if(.not.(ticmrk .eq. 0.))goto 23034 c outward tick annpos = annpos - tiklen 23034 continue call axanno (1,rxmin,rxmax,xcycle,xint,rxllc,ryllc,rxlen, & xpct,xanlab,xfmt,annpos,0.,0) c Left segment 23032 continue if(.not.(yanlab .ge. 0.))goto 23036 ang = 90. ndig = -1 annpos = rxllc - tiklen/2. if(.not.(ticmrk .eq. 0.))goto 23038 annpos = annpos - tiklen 23038 continue if(.not.(yhor .ne. 0.))goto 23040 c correct the position if horizontal ang = 0. ndig = idigts(rymin,rymax,yfmt) annpos = annpos - annlen(0,ndig,hitann) 23040 continue call axanno (2,rymin,rymax,ycycle,yint,rxllc,ryllc,rylen, & ypct,yanlab,yfmt,annpos,ang,ndig) c Right segment 23036 continue if(.not.(ranlab .ge. 0. .and. (rmin.ne.0. .or. rmax.ne.0.) )) & goto 23042 annpos = rxllc + rxlen + tiklen/2. if(.not.(ticmrk .eq. 0.))goto 23044 annpos = annpos + tiklen 23044 continue if(.not.(yhor .eq. 0.))goto 23046 ndig = -1 ang = 90. annpos = annpos + hitann goto 23047 c else 23046 continue ndig = -2 ang = 0. 23047 continue call axanno (4,rmin,rmax,rcycle,rint,rxllc+rxlen,ryllc, & rylen,rpct,ranlab,rfmt,annpos,ang,ndig) 23042 continue c-------------------------------------------------------------------------- c Process AXIS LABELS c-------------------------------------------------------------------------- 23030 continue if(.not.(ilblnw.ne.0))goto 23048 call newpen(ilblnw) c Bottom segment i = len (xlabel) if(.not.(i .gt. 0))goto 23050 xpos = rxllc + (rxlen - annlen (xlabel,i,hitlab))/2. ypos = ryllc - hitlab - 1.5*tiklen if(.not.(xanlab .ge. 0.))goto 23052 ypos = ypos - hitann 23052 continue if(.not.(ticmrk .eq. 0.))goto 23054 ypos = ypos - tiklen 23054 continue call text(xpos,ypos,hitlab,xlabel,0.,i) c Left segment 23050 continue i = len (ylabel) if(.not.(i .gt. 0))goto 23056 ypos = ryllc + (rylen - annlen (ylabel,i,hitlab))/2. xpos = rxllc - 1.5*tiklen if(.not.(ticmrk .eq. 0.))goto 23058 xpos = xpos - tiklen 23058 continue if(.not.(yanlab .ge. 0.))goto 23060 if(.not.(yhor .eq. 0.))goto 23062 xpos = xpos - hitann goto 23063 c else 23062 continue ndig = idigts(rymin,rymax,yfmt) xpos = xpos - annlen(0,ndig,hitann) 23063 continue 23060 continue call text(xpos,ypos,hitlab,ylabel,90.,i) c Right segment 23056 continue i = len (rlabel) if(.not.(i .gt. 0))goto 23064 ypos = ryllc + .5*rylen + .5*annlen (rlabel,i,hitlab) xpos = rxllc + rxlen + 1.5*tiklen if(.not.(ticmrk .eq. 0.))goto 23066 xpos = xpos + tiklen 23066 continue if(.not.(ranlab .ge. 0.))goto 23068 if(.not.(yhor .eq. 0.))goto 23070 xpos = xpos + hitann goto 23071 c else 23070 continue ndig = idigts(rmin,rmax,rfmt) xpos = xpos + annlen(0,ndig,hitann) 23071 continue 23068 continue call text(xpos,ypos,hitlab,rlabel,270.,i) 23064 continue 23048 continue return end