integer function skdecs (instr, mw, coo, imcoo) logical Memb(1) integer*2 Memc(1) integer*2 Mems(1) integer Memi(1) integer*4 Meml(1) real Memr(1) double precision Memd(1) complex Memx(1) equivalence (Memb, Memc, Mems, Memi, Meml, Memr, Memd, Memx) common /Mem/ Memd integer mw integer coo integer imcoo integer*2 instr(*) integer stat integer sp integer str1 integer str2 integer laxno integer paxval integer im integer skstrs integer skdecm integer immap logical xerpop logical xerflg common /xercom/ xerflg integer sw0001 save call xcallc(coo, (30 + 255 + 1), 10 ) call xstrcy(instr, memc((((coo+25)-1)*2+1)) , 255 ) call smark (sp) call salloc (str1, 1023 , 2) call salloc (str2, 1023 , 2) call salloc (laxno, 7 , 4) call salloc (paxval, 7 , 4) call sscan (instr) call gargwd (memc(str1), 1023 ) call gargwd (memc(str2), 1023 ) call xerpsh im = immap (memc(str1), 1 , 0) if (xerflg) goto 112 112 if (.not.xerpop()) goto 110 mw = 0 if (.not.(imcoo .eq. 0)) goto 120 memi(coo+20) = 2048 memi(coo+21) = 2048 memi(coo+15) = 1 memi(coo+16) = 2 memi(coo+17) = 1 memi(coo+18) = 2 memd((((coo)-1)/2+1)) = 0.0d0 memd((((coo+2)-1)/2+1)) = 0.0d0 memd((((coo+4)-1)/2+1)) = 1.0d0 memd((((coo+6)-1)/2+1)) = 1.0d0 memi(coo+14) = 0 goto 121 120 continue memi(coo+20) = memi(imcoo+20) memi(coo+21) = memi(imcoo+21) memi(coo+15) = memi(imcoo+15) memi(coo+16) = memi(imcoo+16) memi(coo+17) = memi(imcoo+17) memi(coo+18) = memi(imcoo+18) memd((((coo)-1)/2+1)) = memd((((imcoo)-1)/2+1)) memd((((coo+2)-1)/2+1)) = memd((((imcoo+2)-1)/2+1)) memd((((coo+4)-1)/2+1)) = memd((((imcoo+4)-1)/2+1)) memd((((coo+6)-1)/2+1)) = memd((((imcoo+6)-1)/2+1)) memi(coo+14) = memi(imcoo+14) 121 continue memi(coo+19) = 4 stat = skstrs (instr, memi(coo+12) , memi(coo+13) , memd(((( * coo+8)-1)/2+1)) , memd((((coo+10)-1)/2+1)) ) sw0001=(memi(coo+12) ) goto 130 140 continue memi(coo+22) = 3 memi(coo+23) = 1 goto 131 150 continue memi(coo+22) = 1 memi(coo+23) = 1 goto 131 130 continue if (sw0001.eq.1) goto 140 goto 150 131 continue goto 111 110 continue stat = skdecm (im, memc(str2), mw, coo) call imunmp (im) 111 continue call sfree (sp) memi(coo+24) = stat skdecs = (stat) goto 100 100 return end integer function skdecr (instr, coo, imcoo) logical Memb(1) integer*2 Memc(1) integer*2 Mems(1) integer Memi(1) integer*4 Meml(1) real Memr(1) double precision Memd(1) complex Memx(1) equivalence (Memb, Memc, Mems, Memi, Meml, Memr, Memd, Memx) common /Mem/ Memd integer coo integer imcoo integer*2 instr(*) integer stat integer skstrs integer sw0001 save call xcallc(coo, (30 + 255 + 1), 10 ) call xstrcy(instr, memc((((coo+25)-1)*2+1)) , 255 ) if (.not.(imcoo .eq. 0)) goto 110 memi(coo+20) = 2048 memi(coo+21) = 2048 memi(coo+15) = 1 memi(coo+16) = 2 memi(coo+17) = 1 memi(coo+18) = 2 memd((((coo)-1)/2+1)) = 0.0d0 memd((((coo+2)-1)/2+1)) = 0.0d0 memd((((coo+4)-1)/2+1)) = 1.0d0 memd((((coo+6)-1)/2+1)) = 1.0d0 memi(coo+14) = 0 goto 111 110 continue memi(coo+20) = memi(imcoo+20) memi(coo+21) = memi(imcoo+21) memi(coo+15) = memi(imcoo+15) memi(coo+16) = memi(imcoo+16) memi(coo+17) = memi(imcoo+17) memi(coo+18) = memi(imcoo+18) memd((((coo)-1)/2+1)) = memd((((imcoo)-1)/2+1)) memd((((coo+2)-1)/2+1)) = memd((((imcoo+2)-1)/2+1)) memd((((coo+4)-1)/2+1)) = memd((((imcoo+4)-1)/2+1)) memd((((coo+6)-1)/2+1)) = memd((((imcoo+6)-1)/2+1)) memi(coo+14) = memi(imcoo+14) 111 continue memi(coo+19) = 4 stat = skstrs (instr, memi(coo+12) , memi(coo+13) , memd((((coo * +8)-1)/2+1)) , memd((((coo+10)-1)/2+1)) ) sw0001=(memi(coo+12) ) goto 120 130 continue memi(coo+22) = 3 memi(coo+23) = 1 goto 121 140 continue memi(coo+22) = 1 memi(coo+23) = 1 goto 121 120 continue if (sw0001.eq.1) goto 130 goto 140 121 continue memi(coo+24) = stat skdecr = (stat) goto 100 100 return end integer function skdecm (im, wcs, mw, coo) logical Memb(1) integer*2 Memc(1) integer*2 Mems(1) integer Memi(1) integer*4 Meml(1) real Memr(1) double precision Memd(1) complex Memx(1) equivalence (Memb, Memc, Mems, Memi, Meml, Memr, Memd, Memx) common /Mem/ Memd integer im integer mw integer coo integer*2 wcs(*) integer stat integer sp integer str1 integer laxno integer paxval integer skimws integer strdic integer mwstai integer mwopem logical xerpop logical xerflg common /xercom/ xerflg integer sw0001 integer*2 st0001(6) integer*2 st0002(28) save integer iyy data st0001 / 37,115, 32, 37,115, 0/ data (st0002(iyy),iyy= 1, 8) /124,108,111,103,105, 99, 97,108/ data (st0002(iyy),iyy= 9,16) /124,116,118,124,112,104,121,115/ data (st0002(iyy),iyy=17,24) /105, 99, 97,108,124,119,111,114/ data (st0002(iyy),iyy=25,28) /108,100,124, 0/ call xmallc(coo, (30 + 255 + 1), 10 ) call sprinf (memc((((coo+25)-1)*2+1)) , 255 , st0001) call pargsr (memc((((im+200 +165)-1)*2+1)) ) call pargsr (wcs) call smark (sp) call salloc (str1, 1023 , 2) call salloc (laxno, 7 , 4) call salloc (paxval, 7 , 4) call xerpsh mw = mwopem (im) if (xerflg) goto 112 112 if (.not.xerpop()) goto 110 memi(coo+12) = 0 memi(coo+13) = 0 memd((((coo+8)-1)/2+1)) = 1.6d308 memd((((coo+10)-1)/2+1)) = 1.6d308 mw = 0 memi(coo+15) = 1 memi(coo+16) = 2 memi(coo+17) = 1 memi(coo+18) = 2 memi(coo+20) = 2048 memi(coo+21) = 2048 memd((((coo)-1)/2+1)) = 0.0d0 memd((((coo+2)-1)/2+1)) = 0.0d0 memd((((coo+4)-1)/2+1)) = 1.0d0 memd((((coo+6)-1)/2+1)) = 1.0d0 memi(coo+14) = 0 memi(coo+19) = 1 memi(coo+22) = 1 memi(coo+23) = 1 stat = -1 goto 111 110 continue memi(coo+19) = strdic (wcs, memc(str1), 1023 , st0002) if (.not.(memi(coo+19) .le. 0)) goto 120 memi(coo+19) = 1 120 continue if (.not.(skimws (im, mw, memi(coo+12) , memi(coo+15) , memi * (coo+16) , memi(coo+14) , memi(coo+13) , memd((((coo+8)-1)/2 * +1)) , memd((((coo+10)-1)/2+1)) ) .eq. 0)) goto 130 sw0001=(memi(coo+12) ) goto 140 150 continue memi(coo+22) = 3 memi(coo+23) = 1 goto 141 160 continue memi(coo+22) = 1 memi(coo+23) = 1 goto 141 140 continue if (sw0001.eq.1) goto 150 goto 160 141 continue call mwgaxp (mw, memi(laxno), memi(paxval), mwstai(mw, 5 * )) if (.not.(memi(laxno+memi(coo+15) -1) .lt. memi(laxno+ * memi(coo+16) -1))) goto 170 memi(coo+17) = memi(laxno+memi(coo+15) -1) memi(coo+18) = memi(laxno+memi(coo+16) -1) goto 171 170 continue memi(coo+17) = memi(laxno+memi(coo+16) -1) memi(coo+18) = memi(laxno+memi(coo+15) -1) 171 continue if (.not.(memi(coo+17) .le. 0 .or. memi(coo+18) .le. 0)) * goto 180 memd((((coo)-1)/2+1)) = 0.0d0 memd((((coo+2)-1)/2+1)) = 0.0d0 memd((((coo+4)-1)/2+1)) = 1.0d0 memd((((coo+6)-1)/2+1)) = 1.0d0 memi(coo+20) = 2048 memi(coo+21) = 2048 stat = -1 goto 181 180 continue memd((((coo)-1)/2+1)) = meml(im+memi(im+memi(coo+17) + * 47-1) +54-1) memd((((coo+2)-1)/2+1)) = meml(im+memi(im+memi(coo+18) * +47-1) +54-1) memd((((coo+4)-1)/2+1)) = memi(im+memi(coo+17) +59-1) memd((((coo+6)-1)/2+1)) = memi(im+memi(coo+18) +59-1) memi(coo+20) = meml(im+200 +memi(coo+17) +8-1) memi(coo+21) = meml(im+200 +memi(coo+18) +8-1) stat = 0 181 continue goto 131 130 continue call mwcloe (mw) mw = 0 memi(coo+17) = 1 memi(coo+18) = 2 memi(coo+20) = 2048 memi(coo+21) = 2048 memd((((coo)-1)/2+1)) = 0.0d0 memd((((coo+2)-1)/2+1)) = 0.0d0 memd((((coo+4)-1)/2+1)) = 1.0d0 memd((((coo+6)-1)/2+1)) = 1.0d0 memi(coo+22) = 1 memi(coo+23) = 1 stat = -1 131 continue 111 continue call sfree (sp) memi(coo+24) = stat skdecm = (stat) goto 100 100 return end integer function skstrs (instr, ctype, radecs, equinx, epoch) integer ctype integer radecs double precision equinx double precision epoch integer*2 instr(*) integer ip integer nitems integer sctype integer srades integer stat logical Memb(1) integer*2 Memc(1) integer*2 Mems(1) integer Memi(1) integer*4 Meml(1) real Memr(1) double precision Memd(1) complex Memx(1) equivalence (Memb, Memc, Mems, Memi, Meml, Memr, Memd, Memx) common /Mem/ Memd integer sp integer str1 integer str2 integer strdic integer nscan integer ctod double precision slej2d double precision slepb double precision sleb2d double precision slepj integer sw0001,sw0002,sw0003 integer*2 st0001(63) save integer iyy data (st0001(iyy),iyy= 1, 8) /124,102,107, 52,124,110,111,101/ data (st0001(iyy),iyy= 9,16) /102,107, 52,124,102,107, 53,124/ data (st0001(iyy),iyy=17,24) /105, 99,114,115,124, 97,112,112/ data (st0001(iyy),iyy=25,32) / 97,114,101,110,116,124,101, 99/ data (st0001(iyy),iyy=33,40) /108,105,112,116,105, 99,124,103/ data (st0001(iyy),iyy=41,48) / 97,108, 97, 99,116,105, 99,124/ data (st0001(iyy),iyy=49,56) /115,117,112,101,114,103, 97,108/ data (st0001(iyy),iyy=57,63) / 97, 99,116,105, 99,124, 0/ ctype = 0 radecs = 0 equinx = 1.6d308 epoch = 1.6d308 call smark (sp) call salloc (str1, 1023 , 2) call salloc (str2, 1023 , 2) call sscan (instr) call gargwd (memc(str1), 1023 ) if (.not.(memc(str1) .eq. 0 .or. nscan() .lt. 1)) goto 110 call sfree (sp) skstrs = (-1) goto 100 110 continue nitems = 1 111 continue sctype = strdic (memc(str1), memc(str2), 1023 , st0001) if (.not.(sctype .le. 0)) goto 120 ctype = 1 goto 121 120 continue sw0001=(sctype) goto 130 140 continue ctype = 1 radecs = 1 goto 131 150 continue ctype = 1 radecs = 2 goto 131 160 continue ctype = 1 radecs = 3 goto 131 170 continue ctype = 1 radecs = 4 goto 131 180 continue ctype = 1 radecs = 5 goto 131 190 continue ctype = 2 goto 131 200 continue ctype = 3 goto 131 210 continue ctype = 4 goto 131 130 continue if (sw0001.lt.1.or.sw0001.gt.8) goto 131 goto (140,150,160,170,180,190,200,210),sw0001 131 continue call gargwd (memc(str1), 1023 ) if (.not.(nscan() .gt. nitems)) goto 220 nitems = nitems + 1 220 continue 121 continue sctype = ctype srades = radecs sw0002=(sctype) goto 230 240 continue sw0003=(srades) goto 250 260 continue if (.not.(memc(str1) .eq. 74 .or. memc(str1) .eq. 106 .or * . memc(str1) .eq. 66 .or. memc(str1) .eq. 98)) goto 270 ip = 2 goto 271 270 continue ip = 1 271 continue if (.not.(ctod (memc(str1), ip, equinx) .le. 0)) goto 280 equinx = 1950.0d0 280 continue if (.not.(memc(str1) .eq. 74 .or. memc(str1) .eq. 106)) * goto 290 equinx = slepb (slej2d (equinx)) 290 continue call gargwd (memc(str2), 1023 ) if (.not.(nscan() .le. nitems)) goto 300 epoch = sleb2d (equinx) goto 301 300 continue if (.not.(memc(str2) .eq. 74 .or. memc(str2) .eq. 106 * .or. memc(str2) .eq. 66 .or. memc(str2) .eq. 98)) goto * 310 ip = 2 goto 311 310 continue ip = 1 311 continue if (.not.(ctod (memc(str2), ip, epoch) .le. 0)) goto * 320 epoch = sleb2d (equinx) goto 321 320 continue if (.not.(epoch .le. 3000.0d0 .and. (memc(str2) .eq. * 74 .or. memc(str2) .eq. 106))) goto 330 epoch = slej2d (epoch) goto 331 330 continue if (.not.(epoch .gt. 3000.0d0)) goto 340 epoch = epoch - 2400000.5d0 goto 341 340 continue epoch = sleb2d (epoch) 341 continue 331 continue 321 continue 301 continue goto 251 350 continue if (.not.(memc(str1) .eq. 74 .or. memc(str1) .eq. 106 .or * . memc(str1) .eq. 66 .or. memc(str1) .eq. 98)) goto 360 ip = 2 goto 361 360 continue ip = 1 361 continue if (.not.(ctod (memc(str1), ip, equinx) .le. 0)) goto 370 equinx = 2000.0d0 370 continue if (.not.(memc(str1) .eq. 66 .or. memc(str1) .eq. 98)) * goto 380 equinx = slepj(sleb2d (equinx)) 380 continue call gargwd (memc(str2), 1023 ) if (.not.(nscan() .le. nitems)) goto 390 epoch = slej2d (equinx) goto 391 390 continue if (.not.(memc(str2) .eq. 74 .or. memc(str2) .eq. 106 * .or. memc(str2) .eq. 66 .or. memc(str2) .eq. 98)) goto * 400 ip = 2 goto 401 400 continue ip = 1 401 continue if (.not.(ctod (memc(str2), ip, epoch) .le. 0)) goto * 410 epoch = slej2d (equinx) goto 411 410 continue if (.not.(epoch .le. 3000.0d0 .and. (memc(str2) .eq. * 66 .or. memc(str2) .eq. 98))) goto 420 epoch = sleb2d (epoch) goto 421 420 continue if (.not.(epoch .gt. 3000.0d0)) goto 430 epoch = epoch - 2400000.5d0 goto 431 430 continue epoch = slej2d (epoch) 431 continue 421 continue 411 continue 391 continue goto 251 440 continue equinx = 2000.0d0 if (.not.(memc(str1) .eq. 74 .or. memc(str1) .eq. 106 .or * . memc(str1) .eq. 66 .or. memc(str1) .eq. 98)) goto 450 ip = 2 goto 451 450 continue ip = 1 451 continue if (.not.(ctod (memc(str1), ip, epoch) .le. 0)) goto 460 epoch = 1.6d308 goto 461 460 continue if (.not.(epoch .le. 3000.0d0)) goto 470 if (.not.(memc(str1) .eq. 66 .or. memc(str1) .eq. 98)) * goto 480 epoch = sleb2d (epoch) goto 481 480 continue if (.not.(memc(str1) .eq. 74 .or. memc(str1) .eq. 106) * ) goto 490 epoch = slej2d (epoch) goto 491 490 continue if (.not.(epoch .lt. 1984.0d0)) goto 500 epoch = sleb2d (epoch) goto 501 500 continue epoch = slej2d (epoch) 501 continue 491 continue 481 continue goto 471 470 continue epoch = epoch - 2400000.5d0 471 continue 461 continue goto 251 510 continue ip = 1 if (.not.(memc(str1) .eq. 66 .or. memc(str1) .eq. 98)) * goto 520 radecs = 1 ip = ip + 1 if (.not.(ctod (memc(str1), ip, equinx) .le. 0)) goto * 530 equinx = 1950.0d0 530 continue call gargwd (memc(str2), 1023 ) if (.not.(nscan() .le. nitems)) goto 540 epoch = sleb2d (equinx) goto 541 540 continue if (.not.(memc(str2) .eq. 74 .or. memc(str2) .eq. * 106)) goto 550 ip = 2 goto 551 550 continue if (.not.(memc(str2) .eq. 66 .or. memc(str2) .eq. * 98)) goto 560 ip = 2 goto 561 560 continue ip = 1 561 continue 551 continue if (.not.(ctod (memc(str2), ip, epoch) .le. 0)) * goto 570 epoch = sleb2d (equinx) goto 571 570 continue if (.not.(epoch .le. 3000.0d0 .and. (memc(str2) .eq * . 74 .or. memc(str2) .eq. 106))) goto 580 epoch = slej2d (epoch) goto 581 580 continue if (.not.(epoch .gt. 3000.0d0)) goto 590 epoch = epoch - 2400000.5d0 goto 591 590 continue epoch = sleb2d (epoch) 591 continue 581 continue 571 continue 541 continue goto 521 520 continue if (.not.(memc(str1) .eq. 74 .or. memc(str1) .eq. 106)) * goto 600 radecs = 3 ip = ip + 1 if (.not.(ctod (memc(str1), ip, equinx) .le. 0)) goto * 610 equinx = 2000.0d0 610 continue call gargwd (memc(str2), 1023 ) if (.not.(nscan() .le. nitems)) goto 620 epoch = slej2d (equinx) goto 621 620 continue if (.not.(memc(str2) .eq. 74 .or. memc(str2) .eq. * 106 .or. memc(str2) .eq. 66 .or. memc(str2) .eq. 98 * )) goto 630 ip = 2 goto 631 630 continue ip = 1 631 continue if (.not.(ctod (memc(str2), ip, epoch) .le. 0)) * goto 640 epoch = slej2d (equinx) goto 641 640 continue if (.not.(epoch .le. 3000.0d0 .and. (memc(str2) .eq * . 66 .or. memc(str2) .eq. 98))) goto 650 epoch = sleb2d (epoch) goto 651 650 continue if (.not.(epoch .gt. 3000.0d0)) goto 660 epoch = epoch - 2400000.5d0 goto 661 660 continue epoch = slej2d (epoch) 661 continue 651 continue 641 continue 621 continue goto 601 600 continue if (.not.(ctod (memc(str1), ip, equinx) .le. 0)) goto 670 ctype = 0 radecs = 0 equinx = 1.6d308 epoch = 1.6d308 goto 671 670 continue if (.not.(equinx .lt. 1984.0d0)) goto 680 radecs = 1 call gargwd (memc(str2), 1023 ) if (.not.(nscan() .le. nitems)) goto 690 epoch = sleb2d (equinx) goto 691 690 continue if (.not.(memc(str2) .eq. 74 .or. memc(str2) .eq. * 106 .or. memc(str2) .eq. 66 .or. memc(str2) .eq. 98 * )) goto 700 ip = 2 goto 701 700 continue ip = 1 701 continue if (.not.(ctod (memc(str2), ip, epoch) .le. 0)) * goto 710 epoch = sleb2d (equinx) goto 711 710 continue if (.not.(epoch .le. 3000.0d0 .and. (memc(str2) .eq * . 74 .or. memc(str2) .eq. 106))) goto 720 epoch = slej2d (epoch) goto 721 720 continue if (.not.(epoch .gt. 3000.0d0)) goto 730 epoch = epoch - 2400000.5d0 goto 731 730 continue epoch = sleb2d (epoch) 731 continue 721 continue 711 continue 691 continue goto 681 680 continue radecs = 3 call gargwd (memc(str2), 1023 ) if (.not.(nscan() .le. nitems)) goto 740 epoch = slej2d (equinx) goto 741 740 continue if (.not.(memc(str2) .eq. 74 .or. memc(str2) .eq. * 106 .or. memc(str2) .eq. 66 .or. memc(str2) .eq. 98 * )) goto 750 ip = 2 goto 751 750 continue ip = 1 751 continue if (.not.(ctod (memc(str2), ip, epoch) .le. 0)) * goto 760 epoch = slej2d (equinx) goto 761 760 continue if (.not.(epoch .le. 3000.0d0 .and. (memc(str2) .eq * . 66 .or. memc(str2) .eq. 98))) goto 770 epoch = sleb2d (epoch) goto 771 770 continue if (.not.(epoch .gt. 3000.0d0)) goto 780 epoch = epoch - 2400000.5d0 goto 781 780 continue epoch = slej2d (epoch) 781 continue 771 continue 761 continue 741 continue 681 continue 671 continue 601 continue 521 continue goto 251 250 continue if (sw0003.lt.1.or.sw0003.gt.5) goto 510 goto (260,260,350,350,440),sw0003 251 continue goto 231 790 continue if (.not.(memc(str1) .eq. 74 .or. memc(str1) .eq. 106 .or. * memc(str1) .eq. 66 .or. memc(str1) .eq. 98)) goto 800 ip = 2 goto 801 800 continue ip = 1 801 continue if (.not.(ctod (memc(str1), ip, epoch) .le. 0)) goto 810 epoch = 1.6d308 goto 811 810 continue if (.not.(epoch .le. 3000.0d0)) goto 820 if (.not.(memc(str1) .eq. 66 .or. memc(str1) .eq. 98)) * goto 830 epoch = sleb2d (epoch) goto 831 830 continue if (.not.(memc(str1) .eq. 74 .or. memc(str1) .eq. 106)) * goto 840 epoch = slej2d (epoch) goto 841 840 continue if (.not.(epoch .lt. 1984.0d0)) goto 850 epoch = sleb2d (epoch) goto 851 850 continue epoch = slej2d (epoch) 851 continue 841 continue 831 continue goto 821 820 continue epoch = epoch - 2400000.5d0 821 continue 811 continue goto 231 860 continue if (.not.(memc(str1) .eq. 74 .or. memc(str1) .eq. 106 .or. * memc(str1) .eq. 66 .or. memc(str1) .eq. 98)) goto 870 ip = 2 goto 871 870 continue ip = 1 871 continue if (.not.(ctod (memc(str1), ip, epoch) .le. 0)) goto 880 epoch = sleb2d (1950.0d0) goto 881 880 continue if (.not.(epoch .le. 3000.0d0)) goto 890 if (.not.(memc(str1) .eq. 74 .or. memc(str1) .eq. 106)) * goto 900 epoch = slej2d (epoch) goto 901 900 continue if (.not.(memc(str1) .eq. 66 .or. memc(str1) .eq. 98)) * goto 910 epoch = sleb2d (epoch) goto 911 910 continue if (.not.(epoch .lt. 1984.0d0)) goto 920 epoch = sleb2d (epoch) goto 921 920 continue epoch = slej2d (epoch) 921 continue 911 continue 901 continue goto 891 890 continue epoch = epoch - 2400000.5d0 891 continue 881 continue goto 231 230 continue if (sw0002.lt.1.or.sw0002.gt.4) goto 231 goto (240,790,860,860),sw0002 231 continue if (.not.(ctype .eq. 0)) goto 930 stat = -1 goto 931 930 continue if (.not.(ctype .eq. 1 .and. (radecs .eq. 0 .or. ((equinx).eq.1 * .6d308) .or. ((epoch).eq.1.6d308)))) goto 940 stat = -1 goto 941 940 continue if (.not.(ctype .eq. 2 .and. ((epoch).eq.1.6d308))) goto 950 stat = -1 goto 951 950 continue stat = 0 951 continue 941 continue 931 continue call sfree (sp) skstrs = (stat) goto 100 100 return end integer function skimws (im, mw, ctype, lngax, latax, wtype, *radecs, equinx, epoch) logical Memb(1) integer*2 Memc(1) integer*2 Mems(1) integer Memi(1) integer*4 Meml(1) real Memr(1) double precision Memd(1) complex Memx(1) equivalence (Memb, Memc, Mems, Memi, Meml, Memr, Memd, Memx) common /Mem/ Memd integer im integer mw integer ctype integer lngax integer latax integer wtype integer radecs double precision equinx double precision epoch integer i integer ndim integer axtype integer day integer month integer year integer ier integer oldfis integer sp integer atval double precision hours double precision imgetd double precision sleb2d double precision slej2d integer mwstai integer strdic integer dtmdee logical xerpop logical xerflg common /xercom/ xerflg integer sw0001,sw0002,sw0003 integer*2 st0001(7) integer*2 st0002(6) integer*2 st0003(39) integer*2 st0004(6) integer*2 st0005(6) integer*2 st0006(7) integer*2 st0007(114) integer*2 st0008(8) integer*2 st0009(6) integer*2 st0010(9) integer*2 st0011(30) integer*2 st0012(8) integer*2 st0013(8) integer*2 st0014(9) integer*2 st0015(8) integer*2 st0016(8) integer*2 st0017(9) integer*2 st0018(8) integer*2 st0019(8) integer*2 st0020(9) save integer iyy data st0001 / 97,120,116,121,112,101, 0/ data st0002 / 73, 78, 68, 69, 70, 0/ data (st0003(iyy),iyy= 1, 8) /124,114, 97,124,100,101, 99,124/ data (st0003(iyy),iyy= 9,16) /103,108,111,110,124,103,108, 97/ data (st0003(iyy),iyy=17,24) /116,124,101,108,111,110,124,101/ data (st0003(iyy),iyy=25,32) /108, 97,116,124,115,108,111,110/ data (st0003(iyy),iyy=33,39) /124,115,108, 97,116,124, 0/ data st0004 /119,116,121,112,101, 0/ data st0005 /119,116,121,112,101, 0/ data st0006 /108,105,110,101, 97,114, 0/ data (st0007(iyy),iyy= 1, 8) /124,108,105,110,124, 97,122,112/ data (st0007(iyy),iyy= 9,16) /124,116, 97,110,124,115,105,110/ data (st0007(iyy),iyy=17,24) /124,115,116,103,124, 97,114, 99/ data (st0007(iyy),iyy=25,32) /124,122,112,110,124,122,101, 97/ data (st0007(iyy),iyy=33,40) /124, 97,105,114,124, 99,121,112/ data (st0007(iyy),iyy=41,48) /124, 99, 97,114,124,109,101,114/ data (st0007(iyy),iyy=49,56) /124, 99,101, 97,124, 99,111,112/ data (st0007(iyy),iyy=57,64) /124, 99,111,100,124, 99,111,101/ data (st0007(iyy),iyy=65,72) /124, 99,111,111,124, 98,111,110/ data (st0007(iyy),iyy=73,80) /124,112, 99,111,124,103,108,115/ data (st0007(iyy),iyy=81,88) /124,112, 97,114,124, 97,105,116/ data (st0007(iyy),iyy=89,96) /124,109,111,108,124, 99,115, 99/ data (st0007(iyy),iyy=97,104) /124,113,115, 99,124,116,115, 99/ data (st0007(iyy),iyy=105,112) /124,116,110,120,124,122,112,120/ data (st0007(iyy),iyy=113,114) /124, 0/ data st0008 / 69, 81, 85, 73, 78, 79, 88, 0/ data st0009 / 69, 80, 79, 67, 72, 0/ data (st0010(iyy),iyy= 1, 8) / 82, 65, 68, 69, 67, 83, 89, 83/ data (st0010(iyy),iyy= 9, 9) / 0/ data (st0011(iyy),iyy= 1, 8) /124,102,107, 52,124,102,107, 52/ data (st0011(iyy),iyy= 9,16) / 45,110,111, 45,101,124,102,107/ data (st0011(iyy),iyy=17,24) / 53,124,105, 99,114,115,124,103/ data (st0011(iyy),iyy=25,30) / 97,112,112,116,124, 0/ data st0012 / 77, 74, 68, 45, 87, 67, 83, 0/ data st0013 / 77, 74, 68, 45, 79, 66, 83, 0/ data (st0014(iyy),iyy= 1, 8) / 68, 65, 84, 69, 45, 79, 66, 83/ data (st0014(iyy),iyy= 9, 9) / 0/ data st0015 / 77, 74, 68, 45, 87, 67, 83, 0/ data st0016 / 77, 74, 68, 45, 79, 66, 83, 0/ data (st0017(iyy),iyy= 1, 8) / 68, 65, 84, 69, 45, 79, 66, 83/ data (st0017(iyy),iyy= 9, 9) / 0/ data st0018 / 77, 74, 68, 45, 87, 67, 83, 0/ data st0019 / 77, 74, 68, 45, 79, 66, 83, 0/ data (st0020(iyy),iyy= 1, 8) / 68, 65, 84, 69, 45, 79, 66, 83/ data (st0020(iyy),iyy= 9, 9) / 0/ call smark (sp) call salloc (atval, 1023 , 2) ctype = 0 lngax = 0 latax = 0 wtype = 0 radecs = 0 equinx = 1.6d308 epoch = 1.6d308 ndim = mwstai (mw, 5 ) do 110 i = 1, ndim call xerpsh call mwgwas (mw, i, st0001, memc(atval), 1023 ) if (.not.xerpop()) goto 120 call xstrcy(st0002, memc(atval), 1023 ) 120 continue axtype = strdic (memc(atval), memc(atval), 1023 , st0003) sw0001=(axtype) goto 130 140 continue ctype = 1 goto 131 150 continue ctype = 2 goto 131 160 continue ctype = 3 goto 131 170 continue ctype = 4 goto 131 180 continue goto 131 130 continue if (sw0001.lt.1.or.sw0001.gt.8) goto 180 goto (140,140,160,160,150,150,170,170),sw0001 131 continue sw0002=(axtype) goto 190 200 continue lngax = i goto 191 210 continue latax = i goto 191 220 continue goto 191 190 continue if (sw0002.lt.1.or.sw0002.gt.8) goto 220 goto (200,210,200,210,200,210,200,210),sw0002 191 continue 110 continue 111 continue if (.not.(ctype .eq. 0 .or. lngax .eq. 0 .or. latax .eq. 0)) * goto 230 call sfree (sp) skimws = (-1) goto 100 230 continue call xerpsh call mwgwas (mw, lngax, st0004, memc(atval), 1023 ) if (xerflg) goto 242 242 if (.not.xerpop()) goto 240 call xerpsh call mwgwas(mw, latax, st0005, memc(atval), 1023 ) if (.not.xerpop()) goto 250 call xstrcy(st0006, memc(atval), 1023 ) 250 continue 240 continue wtype = strdic (memc(atval), memc(atval), 1023 , st0007) if (.not.(wtype .eq. 0)) goto 260 call sfree (sp) skimws = (-1) goto 100 260 continue if (.not.(ctype .eq. 1)) goto 270 call xerpsh equinx = imgetd (im, st0008) if (xerflg) goto 282 282 if (.not.xerpop()) goto 280 call xerpsh equinx = imgetd (im, st0009) if (xerflg) goto 292 292 if (.not.xerpop()) goto 290 equinx = 1.6d308 290 continue 280 continue call xerpsh call imgstr (im, st0010, memc(atval), 1023 ) if (xerflg) goto 302 302 if (.not.xerpop()) goto 300 radecs = 0 goto 301 300 continue call strlwr (memc(atval)) radecs = strdic (memc(atval), memc(atval), 1023 , st0011) 301 continue if (.not.(radecs .eq. 0)) goto 310 if (.not.(((equinx).eq.1.6d308))) goto 320 radecs = 3 goto 321 320 continue if (.not.(equinx .lt. 1984.0d0)) goto 330 radecs = 1 goto 331 330 continue radecs = 3 331 continue 321 continue 310 continue call xerpsh epoch = imgetd (im, st0012) if (xerflg) goto 342 342 if (.not.xerpop()) goto 340 call xerpsh epoch = imgetd (im, st0013) if (xerflg) goto 352 352 if (.not.xerpop()) goto 350 call xerpsh call imgstr (im, st0014, memc(atval), 1023 ) if (xerflg) goto 362 362 if (.not.xerpop()) goto 360 epoch = 1.6d308 goto 361 360 continue if (.not.(dtmdee (memc(atval), year, month, day, hours * , oldfis) .eq. 0)) goto 370 call slcadj (year, month, day, epoch, ier) if (.not.(ier .ne. 0)) goto 380 epoch = 1.6d308 goto 381 380 continue if (.not.(.not. ((hours).eq.1.6d308) .and. hours . * ge. 0.0d0 .and. hours .le. 24.0d0)) goto 390 epoch = epoch + hours / 24.0d0 390 continue 381 continue goto 371 370 continue epoch = 1.6d308 371 continue 361 continue 350 continue 340 continue sw0003=(radecs) goto 400 410 continue if (.not.(((equinx).eq.1.6d308))) goto 420 equinx = 1950.0d0 420 continue if (.not.(((epoch).eq.1.6d308))) goto 430 epoch = sleb2d (1950.0d0) 430 continue goto 401 440 continue if (.not.(((equinx).eq.1.6d308))) goto 450 equinx = 2000.0d0 450 continue if (.not.(((epoch).eq.1.6d308))) goto 460 epoch = slej2d (2000.0d0) 460 continue goto 401 470 continue equinx = 2000.0d0 goto 401 400 continue if (sw0003.lt.1.or.sw0003.gt.5) goto 401 goto (410,410,440,440,470),sw0003 401 continue if (.not.(((epoch).eq.1.6d308))) goto 480 call sfree (sp) skimws = (-1) goto 100 480 continue 270 continue if (.not.(ctype .eq. 2)) goto 490 call xerpsh epoch = imgetd (im, st0015) if (xerflg) goto 502 502 if (.not.xerpop()) goto 500 call xerpsh epoch = imgetd (im, st0016) if (xerflg) goto 512 512 if (.not.xerpop()) goto 510 call xerpsh call imgstr (im, st0017, memc(atval), 1023 ) if (xerflg) goto 522 522 if (.not.xerpop()) goto 520 epoch = 1.6d308 goto 521 520 continue if (.not.(dtmdee (memc(atval), year, month, day, hours * , oldfis) .eq. 0)) goto 530 call slcadj (year, month, day, epoch, ier) if (.not.(ier .ne. 0)) goto 540 epoch = 1.6d308 goto 541 540 continue if (.not.(.not. ((hours).eq.1.6d308) .and. hours . * ge. 0.0d0 .and. hours .le. 24.0d0)) goto 550 epoch = epoch + hours / 24.0d0 550 continue 541 continue goto 531 530 continue epoch = 1.6d308 531 continue 521 continue 510 continue 500 continue if (.not.(((epoch).eq.1.6d308))) goto 560 call sfree (sp) skimws = (-1) goto 100 560 continue 490 continue if (.not.(ctype .eq. 3 .or. ctype .eq. 4)) goto 570 call xerpsh epoch = imgetd (im, st0018) if (xerflg) goto 582 582 if (.not.xerpop()) goto 580 call xerpsh epoch = imgetd (im, st0019) if (xerflg) goto 592 592 if (.not.xerpop()) goto 590 call xerpsh call imgstr (im, st0020, memc(atval), 1023 ) if (xerflg) goto 602 602 if (.not.xerpop()) goto 600 epoch = sleb2d (1950.0d0) goto 601 600 continue if (.not.(dtmdee (memc(atval), year, month, day, hours * , oldfis) .eq. 0)) goto 610 call slcadj (year, month, day, epoch, ier) if (.not.(ier .ne. 0)) goto 620 epoch = sleb2d (1950.0d0) goto 621 620 continue if (.not.(.not. ((hours).eq.1.6d308) .and. hours * .ge. 0.0d0 .and. hours .le. 24.0d0)) goto 630 epoch = epoch + hours / 24.0d0 630 continue 621 continue goto 611 610 continue epoch = sleb2d (1950.0d0) 611 continue 601 continue 590 continue 580 continue 570 continue call sfree (sp) skimws = (0) goto 100 100 return end subroutine skenws (coo, wcsstr, maxch) logical Memb(1) integer*2 Memc(1) integer*2 Mems(1) integer Memi(1) integer*4 Meml(1) real Memr(1) double precision Memd(1) complex Memx(1) equivalence (Memb, Memc, Mems, Memi, Meml, Memr, Memd, Memx) common /Mem/ Memd integer coo integer maxch integer*2 wcsstr(*) double precision skstad double precision slepj double precision slepb integer skstai integer sw0001,sw0002 integer*2 st0001(9) integer*2 st0002(16) integer*2 st0003(18) integer*2 st0004(19) integer*2 st0005(18) integer*2 st0006(21) integer*2 st0007(9) integer*2 st0008(16) integer*2 st0009(16) integer*2 st0010(21) save integer iyy data (st0001(iyy),iyy= 1, 8) / 97,112,112, 97,114,101,110,116/ data (st0001(iyy),iyy= 9, 9) / 0/ data (st0002(iyy),iyy= 1, 8) / 97,112,112, 97,114,101,110,116/ data (st0002(iyy),iyy= 9,16) / 32, 74, 37, 48, 46, 56,102, 0/ data (st0003(iyy),iyy= 1, 8) /102,107, 53, 32, 74, 37, 48, 46/ data (st0003(iyy),iyy= 9,16) / 51,102, 32, 74, 37, 48, 46, 56/ data (st0003(iyy),iyy=17,18) /102, 0/ data (st0004(iyy),iyy= 1, 8) /105, 99,114,115, 32, 74, 37, 48/ data (st0004(iyy),iyy= 9,16) / 46, 51,102, 32, 74, 37, 48, 46/ data (st0004(iyy),iyy=17,19) / 56,102, 0/ data (st0005(iyy),iyy= 1, 8) /102,107, 52, 32, 66, 37, 48, 46/ data (st0005(iyy),iyy= 9,16) / 51,102, 32, 66, 37, 48, 46, 56/ data (st0005(iyy),iyy=17,18) /102, 0/ data (st0006(iyy),iyy= 1, 8) /102,107, 52,110,111,101, 32, 66/ data (st0006(iyy),iyy= 9,16) / 37, 48, 46, 51,102, 32, 66, 37/ data (st0006(iyy),iyy=17,21) / 48, 46, 56,102, 0/ data (st0007(iyy),iyy= 1, 8) /101, 99,108,105,112,116,105, 99/ data (st0007(iyy),iyy= 9, 9) / 0/ data (st0008(iyy),iyy= 1, 8) /101, 99,108,105,112,116,105, 99/ data (st0008(iyy),iyy= 9,16) / 32, 74, 37, 48, 46, 56,102, 0/ data (st0009(iyy),iyy= 1, 8) /103, 97,108, 97, 99,116,105, 99/ data (st0009(iyy),iyy= 9,16) / 32, 74, 37, 48, 46, 56,102, 0/ data (st0010(iyy),iyy= 1, 8) /115,117,112,101,114,103, 97,108/ data (st0010(iyy),iyy= 9,16) / 97, 99,116,105, 99, 32,106, 37/ data (st0010(iyy),iyy=17,21) / 48, 46, 56,102, 0/ sw0001=(skstai (coo, 7)) goto 110 120 continue sw0002=(skstai(coo, 8)) goto 130 140 continue if (.not.(((skstad(coo, 6)).eq.1.6d308))) goto 150 call sprinf (wcsstr, maxch, st0001) goto 151 150 continue call sprinf (wcsstr, maxch, st0002) call pargd (slepj(skstad(coo, 6))) 151 continue goto 131 160 continue call sprinf (wcsstr, maxch, st0003) call pargd (skstad(coo, 5)) call pargd (slepj(skstad(coo, 6))) goto 131 170 continue call sprinf (wcsstr, maxch, st0004) call pargd (skstad(coo, 5)) call pargd (slepj(skstad(coo, 6))) goto 131 180 continue call sprinf (wcsstr, maxch, st0005) call pargd (skstad(coo, 5)) call pargd (slepb(skstad(coo, 6))) goto 131 190 continue call sprinf (wcsstr, maxch, st0006) call pargd (skstad(coo, 5)) call pargd (slepb(skstad(coo, 6))) goto 131 200 continue wcsstr(1) = 0 goto 131 130 continue if (sw0002.lt.1.or.sw0002.gt.5) goto 200 goto (180,190,160,170,140),sw0002 131 continue goto 111 210 continue if (.not.(((skstad(coo, 6)).eq.1.6d308))) goto 220 call sprinf (wcsstr, maxch, st0007) goto 221 220 continue call sprinf (wcsstr, maxch, st0008) call pargd (slepj(skstad(coo, 6))) 221 continue goto 111 230 continue call sprinf (wcsstr, maxch, st0009) call pargd (slepj(skstad(coo, 6))) goto 111 240 continue call sprinf (wcsstr, maxch, st0010) call pargd (slepj(skstad(coo, 6))) goto 111 110 continue if (sw0001.lt.1.or.sw0001.gt.4) goto 111 goto (120,210,230,240),sw0001 111 continue 100 return end integer function skcopy (cooin) logical Memb(1) integer*2 Memc(1) integer*2 Mems(1) integer Memi(1) integer*4 Meml(1) real Memr(1) double precision Memd(1) complex Memx(1) equivalence (Memb, Memc, Mems, Memi, Meml, Memr, Memd, Memx) common /Mem/ Memd integer cooin integer cooout save if (.not.(cooin .eq. 0)) goto 110 cooout = 0 goto 111 110 continue call xcallc(cooout, (30 + 255 + 1), 10 ) memd((((cooout)-1)/2+1)) = memd((((cooin)-1)/2+1)) memd((((cooout+2)-1)/2+1)) = memd((((cooin+2)-1)/2+1)) memd((((cooout+4)-1)/2+1)) = memd((((cooin+4)-1)/2+1)) memd((((cooout+6)-1)/2+1)) = memd((((cooin+6)-1)/2+1)) memd((((cooout+8)-1)/2+1)) = memd((((cooin+8)-1)/2+1)) memd((((cooout+10)-1)/2+1)) = memd((((cooin+10)-1)/2+1)) memi(cooout+12) = memi(cooin+12) memi(cooout+13) = memi(cooin+13) memi(cooout+14) = memi(cooin+14) memi(cooout+15) = memi(cooin+15) memi(cooout+16) = memi(cooin+16) memi(cooout+17) = memi(cooin+17) memi(cooout+18) = memi(cooin+18) memi(cooout+19) = memi(cooin+19) memi(cooout+20) = memi(cooin+20) memi(cooout+21) = memi(cooin+21) memi(cooout+22) = memi(cooin+22) memi(cooout+23) = memi(cooin+23) call xstrcy(memc((((cooin+25)-1)*2+1)) , memc((((cooout+25)- * 1)*2+1)) , 255 ) 111 continue skcopy = (cooout) goto 100 100 return end subroutine skcloe (coo) logical Memb(1) integer*2 Memc(1) integer*2 Mems(1) integer Memi(1) integer*4 Meml(1) real Memr(1) double precision Memd(1) complex Memx(1) equivalence (Memb, Memc, Mems, Memi, Meml, Memr, Memd, Memx) common /Mem/ Memd integer coo save if (.not.(coo .ne. 0)) goto 110 call xmfree(coo, 10 ) 110 continue 100 return end c sprinf sprintf c dtmdee dtm_decode c skenws sk_enwcs c skstad sk_statd c radecs radecsys c equinx equinox c skdecs sk_decwcs c skimws sk_imwcs c skstrs sk_strwcs c skdecr sk_decwstr c skstai sk_stati c mwstai mw_stati c skdecm sk_decim c mwgaxp mw_gaxmap c gargwd gargwrd c sleb2d sl_eb2d c mwopem mw_openim c oldfis oldfits c imunmp imunmap c mwgwas mw_gwattrs c skcopy sk_copy c slej2d sl_ej2d c srades sradecsys c slcadj sl_cadj c skcloe sk_close c pargsr pargstr c mwcloe mw_close