Repatch (from linux) of OSX IRAF

1 files changed, 218 insertions, 0 deletions

diff --git a/sys/gio/nspp/portlib/gridal.f b/sys/gio/nspp/portlib/gridal.f
new file mode 100644
index 00000000..814cb42e
--- /dev/null
+++ b/sys/gio/nspp/portlib/gridal.f
@@ -0,0 +1,218 @@
+      subroutine gridal (imajx,iminx,imajy,iminy,ixlab,iylab,iflg,x,y)
+      common /sysplt/ mmajx  ,mmajy  ,mminx  ,mminy  ,mxlab  ,mylab  ,
+     1                mflg   ,mtype  ,mxa    ,mya    ,mxb    ,myb    ,
+     2                mx     ,my     ,mtypex ,mtypey ,xxa    ,yya    ,
+     3                xxb    ,yyb    ,xxc    ,yyc    ,xxd    ,yyd    ,
+     4                xfactr ,yfactr ,xadd   ,yadd   ,xx     ,yy     ,
+     5                mfmtx(3)       ,mfmty(3)       ,mumx   ,mumy   ,
+     6                msizx  ,msizy  ,mxdec  ,mydec  ,mxor   ,mop(19),
+     7                mname(19)      ,mxold  ,myold  ,mxmax  ,mymax  ,
+     8                mxfac  ,myfac  ,modef  ,mf2er  ,mshftx ,mshfty ,
+     9                mmgrx  ,mmgry  ,mmnrx  ,mmnry  ,mfrend ,mfrlst ,
+     +                mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
+     1                mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
+     2                mxysto ,mprint ,msybuf(360)    ,mncpw  ,minst  ,
+     3                mbufa  ,mbuflu ,mfwa(12)       ,mlwa(12)       ,
+     4                mipair ,mbprs(16)      ,mbufl  ,munit  ,mbswap ,
+     5                small
+c
+c non-compact version of gridal
+c
+c     ray bovet ishft changed to ishfta patch
+      dimension       nmaj(2),nmin(2),nlab(2),nflg(2),num(2) ,zza(2) ,
+     1                zzb(2) ,zzc(2) ,zzd(2) ,ichars(5)      ,
+     2                ifmt(3,2)      ,iz(2)  ,iza(2) ,izb(2) ,imz(2) ,
+     3                izdec(2)       ,isiz(2),imajl(2)       ,
+     4                iminl(2)       ,itype(2)       ,zz(2)  ,
+     5                ishfta(2)       ,izaa(2),izbb(2),kz(4)
+c     ray bovet patch to avoid small integers being set to 0
+      integer x,y,xx,yy
+c
+c
+c     ray bovet ishft changed to ishfta patch
+      equivalence     (xxa,zza(1))   ,(xxb,zzb(1))   ,(xxc,zzc(1))   ,
+     1                (xxd,zzd(1))   ,(mfmtx(1),ifmt(1,1)),
+     2                (mx,iz(1))     ,(mxa,iza(1))   ,(mxb,izb(1))   ,
+     3                (majx,nmaj(1)) ,(minx,nmin(1)) ,(mumx,num(1))  ,
+     4                (mxdec,izdec(1))       ,(msizx,isiz(1)),
+     5                (mmgrx,imajl(1))       ,(mmnrx,iminl(1))       ,
+     6                (mtypex,itype(1))      ,(xx,kz(1))     ,
+     7                (xx,zz(1))     ,(mshftx,ishfta(1))
+c
+c set up variables for loop
+c
+      nmaj(1) = imajx
+      nmaj(2) = imajy
+      nmin(1) = iminx
+      nmin(2) = iminy
+      nlab(1) = ixlab
+      nlab(2) = iylab
+      nflg(1) = ishift(iflg,-2)-1
+      nflg(2) = iand(iflg,3)-1
+      izaa(1) = iza(1)
+      izaa(2) = iza(2)
+      izbb(1) = izb(1)
+      izbb(2) = izb(2)
+      if (nflg(1).le.0 .and. nflg(2).le.0) go to 101
+      xx = x
+      yy = y
+      call trans
+      if (nflg(2) .gt. 0) izaa(1) = mx
+      if (nflg(1) .gt. 0) izaa(2) = my
+      if (nflg(2) .gt. 0) izbb(1) = mx
+      if (nflg(1) .gt. 0) izbb(2) = my
+  101 continue
+      call optn (4hdpat,65535)
+      do 121 i=1,2
+c
+c i=1 for x axis with ticks in y direction
+c i=2 for y axis with ticks in x direction
+c
+         if (nlab(i)) 121,102,102
+  102    continue
+c
+c ior.ne.0 posibility for x only
+c
+         ixor = (2-i)*90*mxor
+         imaj = max0(nmaj(i),1)
+         imin = max0(nmin(i),1)
+         begin = iza(i)
+         biginc = float(izb(i)-iza(i))/float(imaj)
+         smlinc = biginc/float(imin)
+         start = zzc(i)
+         dif = (zzd(i)-zzc(i))/float(imaj)
+         iop = 3-i
+c
+c iop is the opposit axis to i
+c
+         idec = izdec(iop)
+         if (idec .eq. 0) idec = izaa(iop)-izbb(iop)-655
+         if (ixor .eq. i-1) go to 103
+c
+c labels and axis are orthogonal
+c
+         icent = isign(1,idec-1)
+         go to 104
+c
+c labels and axis are parallel
+c
+  103    icent = 0
+  104    continue
+         if (itype(i) .eq. 0) go to 105
+         fact = 10.**imaj
+         if (zzc(i) .gt. zzd(i)) fact = 1./fact
+         val = zzc(i)/fact
+         delval = val
+         if (imin.le.10 .and. imaj.eq.1) imin = 9
+         if (imin .ne. 9) imin = 1
+         imaj = abs(alog10(zzd(i)/zzc(i)))+1.0001
+  105    imajp1 = imaj+1
+         iminm1 = imin-1
+         do 119 j=1,imajp1
+            part = j-1
+c
+c draw major line or tick
+c
+            call optn (4hintn,4hhigh)
+            if (itype(i) .ne. 0) go to 106
+            iz(i) = begin+part*biginc
+            go to 107
+  106       val = val*fact
+            zz(i) = val
+            kz(iop) = 1
+            call trans
+            delval = delval*fact
+            if (iz(i)-10 .gt. izb(i)) go to 120
+  107       continue
+            iz(iop) = izaa(iop)
+            minst = 0
+            call put42
+            if (nflg(i)) 108,109,109
+  108       iz(iop) = izb(iop)
+            minst = 1
+            call put42
+            go to 111
+  109       iz(iop) = izaa(iop)+imajl(iop)
+            minst = 1
+            call put42
+            if (nflg(i)) 110,110,111
+  110       iz(iop) = izb(iop)
+            minst = 0
+            call put42
+            iz(iop) = izb(iop)-imajl(iop)
+            minst = 1
+            call put42
+  111       continue
+c
+c form label if needed
+c
+            if (nlab(i) .le. 0) go to 112
+            if (itype(i) .eq. 0) val = start+part*dif
+            call encode (num(i),ifmt(1,i),ichars,val)
+c     ray bovet ishft changed to ishfta patch
+            imz(i) = ishift(iz(i),-ishfta(i))
+            imz(iop) = max0(1,ishift(izaa(iop)-idec,-ishfta(iop)))
+            njust = num(i)
+            if (icent .eq. 0) call justfy (ichars,num(i),njust)
+            call pwrit (imz(1),imz(2),ichars,njust,isiz(i),ixor,icent)
+c
+c put in minor ticks
+c
+  112       if (iminm1.le.0 .or. j.eq.imajp1) go to 119
+            call optn (4hintn,3hlow)
+            do 118 k=1,iminm1
+               if (itype(i) .ne. 0) go to 113
+               iz(i) = begin+part*biginc+float(k)*smlinc
+               go to 114
+  113          zz(i) = val+float(k)*delval
+               if (zzc(i) .gt. zzd(i)) zzi = val-float(k)*delval*.1
+               kz(iop) = 1
+               call trans
+               if (iz(i) .gt. izb(i)) go to 120
+               if (iz(i) .lt. iza(i)) go to 118
+  114          continue
+               iz(iop) = izaa(iop)
+               minst = 0
+               call put42
+               if (nflg(i)) 115,116,116
+  115          iz(iop) = izb(iop)
+               minst = 1
+               call put42
+               go to 118
+  116          iz(iop) = izaa(iop)+iminl(iop)
+               minst = 1
+               call put42
+               if (nflg(i)) 117,117,118
+  117          iz(iop) = izb(iop)
+               minst = 0
+               call put42
+               iz(iop) = izb(iop)-iminl(iop)
+               minst = 1
+               call put42
+  118       continue
+  119    continue
+         call optn (4hintn,4hhigh)
+  120    if (nflg(iop) .lt. 0) go to 121
+c
+c draw axis line
+c
+         iz(i) = iza(i)
+         iz(iop) = izaa(iop)
+         minst = 0
+         call put42
+         iz(i) = izb(i)
+         iz(iop) = izaa(iop)
+         minst = 1
+         call put42
+         if (nflg(i) .gt. 0) go to 121
+         iz(i) = iza(i)
+         iz(iop) = izb(iop)
+         minst = 0
+         call put42
+         iz(i) = izb(i)
+         iz(iop) = izb(iop)
+         minst = 1
+         call put42
+  121 continue
+      return
+      end