This file contains eight utility programs designed for use with the Wisconsin all-sky soft X-ray survey maps. They are: PIXLB, a subroutine that returns galactic coordinates of any pixel in an Aitoff-projection map; LBPIX, a subroutine that returns the pixel number for an Aitoff projection of the given galactic coordinate; XY, a subroutine used by LBPIX that calculates the X and Y coordinates of the given galactic coordinates for an Aitoff projection; XYPOLE, a subroutine that calculates the X and Y coordinates of the given galactic coordinates for an equal-area polar projection; WRMAP, the subroutine that wrote the export tape map files; RDMAP, a subroutine to read the export tape map files add a map to the map currently residing in memory; and MAPPRT, a subroutine to print a map in our standard format; and REMOVE, a subroutine that zeroes map pixels suspected of contamination in the B and C band maps (REMOVE only works for the 0-centered Aitoff maps). These programs are written in SPERRY-UNIVAC ASCII FORTRAN. Subroutines WRMAP and RDMAP, in particular, contain code that is probably specific to SPERRY-UNIVAC and may be specific to MACC. C C SUBROUTINE: PIXLB C MODIFIED: 6/10/82 BY D. PFRANG, ADDING RADIUS CHECK TO C CHANGE ALTERNATE RETURN. FOR PIXELS WHOSE CENTERS ARE C OUTSIDE THE AITOFF MAP LIMITS, PIXLB WILL GO AHEAD AND C CALCULATE L AND B COORDINATES BUT WILL EXECUTE THE C ALTERNATE RETURN. THIS IS SO PIXELS WHOSE CENTERS FALL C OUTSIDE THE MAP, BUT WHICH MAY HAVE A CORNER OR EDGE C INSIDE THE MAP WILL HAVE L AND B COORDINATES CALCULATED C FOR THEM ANYWAY. IN PRACTICE, USE OF THESE COORDINATES C SHOULD NOT PRESENT A PROBLEM AS THEY ARE USUALLY FAIRLY C CLOSE (TYPICALLY WITHIN 1.5 DEGREES) TO THE CORRECT VALUES. C C DESCRIPTION: C COMPUTES LII,BII FOR PIXEL (IX,IY) OF A ZERO OFFSET C AITOFF ARRAY WITH ANY LONGITUDE AT THE CENTER. C IT ASSUMES THAT THE INPUT MAP IS CONTRACTED BY A FACTOR C OF INTK IN THE X-DIMENSION AND INTJ IN THE Y-DIMENSION C FROM A 181X91 ELEMENT AITOFF MAP. THIS FEATURE IS USED C WHEN MAPS ARE BINNED INTO LARGER PIXEL SIZES FOR C IMPROVED STATISTICS. C C USAGE: CALL PIXLB($XYZ,IX,IY,CENTER,INTK,INTJ,L,B) C IX,IY = COORDINATES OF MAP PIXEL ON AITOFF PROJECTION (INTEGERS). C 0 < IX < 182, 0 < IY < 92, BOTTOM LEFT CORNER OF AITOFF C PROJECTION IS PIXEL (1,1), TOP RIGHT CORNER OF AITOFF C PROJECTION IS PIXEL (181,91). (INPUT VARIABLES.) C CENTER = CENTER LONGITUDE OF PROJECTION (REAL INPUT VARIABLE.) C INTK = FACTOR BY WHICH THE INPUT MAP IS CONTRACTED FROM A 181X91 C AITOFF IN THE X DIRECTION (INTEGER INPUT VARIABLE). C INTJ = FACTOR BY WHICH THE INPUT MAP IS CONTRACTED FROM A 181X91 C AITOFF IN THE Y DIRECTION (INTEGER INPUT VARIABLE). C L,B = OUTPUT VARIABLES: REAL LONGITUDE AND LATITUDE OF PIXEL IX,IY c (in degrees). C $XYZ = STATEMENT LABEL FOR ALTERNATE ERROR RETURN C (USUALLY INDICATES A POINT OUTSIDE THE BOUNDARIES OF THE AITOFF) C NOTE: SEE DOCUMENTATION ABOVE REGARDING MODIFICATION. C C COMMON BLOCKS: C NONE C C SUBROUTINES CALLED BY PIXLB: C NONE C C SUBROUTINE PIXLB(I,J,CENTER,INTK,INTJ,L,B,$) REAL L,LL DATA RAD/57.2957795/ X=(INTK*(2*I-1)-181)/180. Y=(INTJ*(2*J-1)-91)/180. RADIUS = SQRT(X**2 + 4*(Y**2)) @DP SINALP=SQRT((4*Y**2.-1.)**2.+(X*Y*2.)**2.) C IF(ABS(SINALP) .GT. 1.00) return 1 IF(ABS(SINALP) .GT. 1.00) GO TO 17 @DP ALPHA= ASIN(SINALP)*RAD B=90.-ALPHA IF(Y.LT.0.) B=-B IF(SINALP.LE.1.E-4) GO TO 11 COSBET=(1.-X**2.-4.*Y**2.)/SINALP C IF(ABS(COSBET) .GT. 1.00) return 1 IF(ABS(COSBET) .GT. 1.00) GO TO 18 @DP BETA=ACOS(COSBET)*RAD LL=2.*BETA L=LL IF(X.GT.0.) L=360.-LL GO TO 15 11 L=180. 15 L = AMOD(L+CENTER,360.) C IF (RADIUS .LE. 1.00) RETURN @DP C return 1 @DP C C 17 CONTINUE @DP L = 0.0 B = 0.0 return 1 18 CONTINUE @DP L = 0.0 B = 0.0 return 1 END C C SUBROUTINE: LBPIX C AUTHOR: DAVE BURROWS C DATE: OCT 16, 1981 C C DESCRIPTION: THIS SUBROUTINE RETURNS THE PIXEL COORDINATES C OF THE AITOFF MAP PIXEL WHICH CONTAINS THE GIVEN GALACTIC POSITION. C C USAGE: CALL LBPIX(GLONG,GLAT,CENTER,INTK,INTJ,IX,IY) C GLONG = GALACTIC LONGITUDE IN DEGREES (REAL INPUT VARIABLE) C GLAT = GALACTIC LATITUDE IN DEGREES (REAL INPUT VARIABLE) C CENTER = CENTER LONGITUDE IN DEGREES (REAL INPUT VARIABLE) C INTK = CONTRACTION FACTOR OF MAP IN HORIZONTAL DIRECTION FROM 181 PIXELS C (INTEGER INPUT VARIABLE) C INTJ = CONTRACTION FACTOR OF MAP IN VERTICAL DIRECTION FROM 91 PIXELS C (INTEGER INPUT VARIABLE) C IX,IY = OUTPUT VARIABLES: COORDINATES OF PIXEL WHICH CONTAINS C THE SPECIFIED POINT (INTEGERS). C C COMMON BLOCKS: C NONE C C SUBROUTINES CALLED BY LBPIX: C XY C SUBROUTINE LBPIX(GLONG,GLAT,CENTER,INTK,INTJ,IX,IY) REAL L,B L = AMOD((720.+GLONG-CENTER),360.) B = GLAT CALL XY(B,L,X,Y) X = X/5. Y = Y/5. IX = (180*X + 181)/(2*INTK) + 1.0 IY = (180*Y + 91)/(2*INTJ) + 1.0 RETURN END C C SUBROUTINE: XY C AUTHOR: RICK BORKEN C DATE: DEC. 1975 C MODIFIED: 6/2/82 BY DNB TO CORRECTLY HANDLE ALL LONGITUDE VALUES C BETWEEN -3600 DEGREES AND +3600 DEGREES. C C DESCRIPTION: C XY CALCULATES THE X,Y POSITION OF A POINT ON AN AITOFF C PROJECTION, GIVEN THE LATITUDE AND LONGITUDE. C THE PROJECTION IS 5.0 UNITS HIGH AND 10.0 UNITS WIDE, C CENTERED AT 0.,0. C C USAGE: CALL XY(GLAT,GLONG,X,Y) C GLAT = REAL INPUT VARIABLE: LATITUDE OF POINT IN DEGREES C (-90. < GLAT < 90.) C GLONG = REAL INPUT VARIABLE: LONGITUDE OF POINT IN DEGREES C (-3600. < GLONG < 3600.) C X,Y = REAL OUTPUT VARIABLES: LOCATION OF POINT ON PROJECTION C IN IMAGE UNITS ( -5. < X < 5. -2.5 < Y < 2.5 ). C C COMMON BLOCKS: C NONE C C SUBROUTINES CALLED BY XY: C NONE C SUBROUTINE XY(A,B,X,Y) DATA RADIAN/57.29578/ DATA TWORAD/114.59156/ DATA PI/3.14159/ DATA PIO2/1.570796/ ALPHA=(-A+90.0)/RADIAN GLONG=AMOD(B+3600.,360.) IF(GLONG.GT.180.)GLONG=GLONG-360. BETA=GLONG/TWORAD CBETA=COS(BETA) SBETA=SIN(BETA) CALPHA=COS(ALPHA) SALPHA=SIN(ALPHA) SC=-CALPHA SS=SALPHA*SBETA CAP=SALPHA*CBETA IF(CAP.GT.1.0) CAP=1.0 SAP=SQRT(1.0-CAP**2) IF(SAP.LT.0.001) GO TO 1 CBP=SC/SAP SBP=SS/SAP R=SQRT(1.0-CAP) X=R*SBP Y=-(R*CBP)/2.0 X=X*5. Y=Y*5. X=-1.*X RETURN 1 X=0.0 Y=0.0 RETURN END C C SUBROUTINE: XYPOLE C AUTHOR: RICK BORKEN C DATE: DEC, 1975 C C DESCRIPTION: C XYPOLE CALCULATES A POLAR EQUAL AREA-SOLID ANGLE PROJECTION. C FOR EACH INPUT LATITUDE, LONGITUDE POINT (IN DEGREES), A C VALUE OF (X,Y) IS RETURNED (IN INCHES). THE X,Y GRID HAS C ITS ORIGIN AT THE POLE (LATITUDE = +-90.) AND IS C SCALED SO THAT THE DIAMETER OF THE EQUATOR IS 10. INCHES. C LONGITUDE INCREASES CLOCKWISE C FOR A NORTH POLAR PLOT AND COUNTERCLOCKWISE FOR A SOUTH C POLAR PLOT. ZERO LONGITUDE IS AT THE TOP OF THE PAGE. C C USAGE: CALL XYPOLE(GLAT,GLONG,X,Y,IPOS) C GLAT: GALACTIC LATITUDE IN DEGREES (REAL INPUT VARIABLE). C GLONG: GALACTIC LONGITUDE IN DEGREES (REAL INPUT VARIABLE). C X,Y: REAL OUTPUT VARIABLES SPECIFYING COORDINATES OF C THE POINT ON THE POLAR PROJECTION. C IPOS: SPECIFIES HEMISPHERE. (INTEGER INPUT VARIABLE.) C IPOS = 0: GENERATES SOUTH POLAR PROJECTION. C IPOS = 1: GENERATES NORTH POLAR PROJECTION. C C COMMON BLOCKS: C NONE C C SUBROUTINES CALLED BY XYPOLE: C NONE C SUBROUTINE XYPOLE(GLAT,GLONG,X,Y,IPOS) RLAT=ALAT*3.14159265/180. RLONG=ALONG*3.14159265/180. IF(IPOS.EQ.1)GO TO 10 RLAT=-1.*RLAT RLONG=-1.*RLONG 10 CONTINUE SQ=2.*(1.-SIN(RLAT)) IF(SQ.LT.0.)SQ=0. R=3.53553391*SQRT(SQ) Y=R*COS(RLONG) X=R*SIN(RLONG) RETURN END C C SUBROUTINE: WRMAP C AUTHOR: DAVE BURROWS C DATE: 12/8/82 C LANGUAGE: ASCII FORTRAN C C DESCRIPTION: C WRMAP writes out an Aitoff or polar projection map in c the format required by the export tape (80 character ASCII c card images, blocked into 2560 character logical records) c and sets pixels with counts less than zero or exposure less c than 0.001 to zero. C C USAGE: call wrmap(xrmap,ndimx,ndimy,lu,header) c xrmap = map (dimension ndimx x ndimy x 2) to be written onto c logical unit LU. (REAL INPUT ARRAY.) c XRMAP contains two maps: exposure map (ix, iy, 1) c followed by counts map (ix, iy, 2) c LU = Output logical unit - must be assigned in quarter-word c format. (INTEGER INPUT VARIABLE.) c header = 80 character variable containing header record. c This will be written as the first record of the c output file, and will be followed by the map c in 1p8e10.3e2 format. C C COMMON BLOCKS: C COMMON/MINMAX/IXMIN,IXMAX,IYMIN,IYMAX C THIS COMMON BLOCK MUST CONTAIN THE MINIMUM AND C MAXIMUM X AND Y INDICES WITH NON-ZERO PIXELS. C c This subroutine writes an EOF mark at the end of each c call and positions the tape after the EOF. C C SUBROUTINES CALLED BY WRATMP: C NONE c SUBROUTINE WRMAP(XRMAP,NDIMX,NDIMY,LU,HEADER) character*80 header dimension xrmap(ndimx,ndimy,2) COMMON/MINMAX/IXMIN,IXMAX,IYMIN,IYMAX open (unit=lu, access='sequential', form='formatted', + rform='fb', mrecl=80, type='ANSI', block=2560, off=0) write(lu,8000) header 8000 format(a80) JJJ = 1 KKK = 2 DO 103 IX=IXMIN,IXMAX DO 103 IY=IYMIN,IYMAX IF (XRMAP(IX,IY,KKK) .LT. 0.) GO TO 102 IF (XRMAP(IX,IY,JJJ) .GE. 1.E-3) GO TO 103 102 XRMAP(IX,IY,JJJ)=0. XRMAP(IX,IY,KKK)=0. 103 CONTINUE write(lu,8110) (((xrmap(i,j,k),i=1,ndimx),j=1,ndimy),k=1,2) 8110 format(1p8e10.3e2) call close(lu,0) RETURN 999 STOP 999 END C C SUBROUTINE: RDMAP C AUTHOR: DNB C DATE: 7/25/82 C MODIFIED: 8/16/82 BY DNB TO ADD RATAVE AND NPIX. c MODIFIED: 12/6/82 by DNB to: c 1) Use ASCII Fortran. c 2) Read maps from EXPORT-TAPE instead of from standard UW c Aitoff map file. c c MODIFIED: 12/7/82 BY DNB TO ADD MAP ARRAY TO CALL LINE. C This allows it to be used for either Aitoff or polar projections. C c DESCRIPTION: RDMAP reads in maps from the export tape in ASCII images c with 2560 characters per block. The maps are ndimx x ndimy x 2, c with exposures first, then counts. It returns one map per call c and adds it to the map stored in array XRMAP. c The tape must be correctly positioned before calling RDMAP. c RDMAP leaves the tape positioned at the end of the file that c it writes. C C USAGE: CALL RDMAP(XRMAP,NDIMX,NDIMY,LU,RNORM,EXPAVE,CTSAVE, C + RATAVE,NPIX,HEADER) C C XRMAP = INPUT/OUTPUT MAP OF DIMENSION (NDIMX, NDIMY, 2) C CONTAINS TWO MAPS: EXPOSURE MAP (IX, IY, 1), C FOLLOWED BY COUNTS MAP (IX, IY, 2). (REAL) C LU = INPUT LOGICAL UNIT (INTEGER INPUT VARIABLE.) C RNORM = NORMALIZATION FACTOR (REAL INPUT VARIABLE.) C (EXPOSURE MAP IS MULTIPLIED BY RNORM). C EXPAVE = OUTPUT VARIABLE WITH AVERAGE EXPOSURE OF NONZERO PIXELS C OF INPUT MAP (REAL). C CTSAVE = OUTPUT VARIABLE WITH AVERAGE COUNTS OF NONZERO PIXELS C OF INPUT MAP (REAL). C RATAVE = OUTPUT VARIABLE WITH AVERAGE RATE (COUNTS/EXPOSURE) C OF MAP STORED IN XRMAP AFTER CURRENT INPUT MAP IS ADDED C TO STORED MAP (REAL). C NPIX = NUMBER OF NON-ZERO PIXELS IN THE MAP STORED IN XRMAP. C (INTEGER OUTPUT VARIABLE.) C HEADER = FIRST RECORD OF FILE, WHICH CONTAINS AN ASCII HEADER C RECORD (80 CHARACTERS) IDENTIFYING THE FILE. C C COMMON BLOCKS: C COMMON/MINMAX/IXMIN,IXMAX,IYMIN,IYMAX C INDICES OF MINIMUM AND MAXIMUM PIXEL NUMBERS THAT C CONTAIN POSITIVE VALUES. (INTEGERS) C C SUBROUTINES CALLED BY RDMAP: C NONE C SUBROUTINE RDMAP(XRMAP,NDIMX,NDIMY,LU,RNORM,EXPAVE,CTSAVE, + RATAVE,NPIX,HEADER) character*80 header dimension oa(80), XRMAP(NDIMX,NDIMY,2) COMMON/MINMAX/IXMIN,IXMAX,IYMIN,IYMAX data ixmax/0/ixmin/182/iymax/0/iymin/92/ JJJ = 1 KKK = 2 C C FOLLOWING READS IN MAPS C open (unit=lu, access='sequential', form='formatted', + rform='fb', mrecl=80, type='ANSI', block=2560, off=0) c c Read header record c read(lu,8000) header 8000 format(a80) EXPAVE = 0. NUMEXP = 0 CTSAVE = 0. NUMCTS = 0 RATAVE = 0. NUMRAT = 0 index = -1 do 2111 i=1,2 DO 2111 J = 1,ndimy DO 2111 K=1,ndimx index = index + 1 ind = mod(index,80) + 1 if (ind .eq. 1) + read(lu,8010,end=10) (oa(ijk), ijk=1,80) 8010 format(1p8e10.3) 10 IF (I .EQ. KKK) GOTO 1000 IF (OA(IND) .LE. 1.E-8) GO TO 2111 IF (K.GT.IXMAX) IXMAX=K IF (K.LT.IXMIN) IXMIN=K IF (J.GT.IYMAX) IYMAX=J IF (J.LT.IYMIN) IYMIN=J XRMAP(K,J,JJJ) = XRMAP(K,J,JJJ)+RNORM*OA(IND) EXPAVE = EXPAVE + RNORM*OA(IND) NUMEXP = NUMEXP + 1 GO TO 2111 1000 IF (J .GT. IYMAX) GO TO 2111 IF (J .LT. IYMIN) GO TO 2111 XRMAP(K,J,KKK) = XRMAP(K,J,KKK) + OA(IND) CTSAVE = CTSAVE + OA(IND) NUMCTS = NUMCTS + 1 IF (XRMAP(K,J,JJJ) .LE. 1.E-10) GO TO 2000 RATAVE = RATAVE + XRMAP(K,J,KKK)/XRMAP(K,J,JJJ) NUMRAT = NUMRAT + 1 2000 CONTINUE 2111 CONTINUE IF (NUMEXP .LT. 1) GO TO 100 EXPAVE = EXPAVE/NUMEXP 100 IF (NUMCTS .LT. 1) GO TO 150 CTSAVE = CTSAVE/NUMCTS 150 IF (NUMRAT .LT. 1) GO TO 200 RATAVE = RATAVE/NUMRAT 200 NPIX = MIN0(NUMEXP,NUMCTS,NUMRAT) call close(lu,0) RETURN END C C SUBROUTINE: MAPPRT C AUTHOR: DAVE BURROWS C DATE: JAN. 1981 C MODIFIED: 10/20/81 BY DNB TO PRINT COLUMN NUMBERS AT TOP OF C EACH PAGE. C MODIFIED: 3 SEPT., 1981 BY CME C ADDED FACTOR TO CALLING PARAMETERS. THIS SHOULD BE A POWER C OF 10 WHICH WILL MAKE THE DATA ON THE ORDER OF 100 WHEN IT C IS PRINTED OUT. C C MODIFIED: 12/6/82 BY DNB FOR ASCII FORTRAN USE. C C DESCRIPTION: MAPPRT PRINTS OUT AN AITOFF OR POLAR MAP. C This version is modified for ASCII Fortran. C C USAGE: CALL MAPPRT(LINES,IMAP,NDIMX,NDIMY,FACTOR,HEADER) C ALL PARAMETERS ARE INPUT VARIABLES: C LINES(NDIMX,NDIMY,2) = REAL INPUT ARRAY OF MAP DATA. C IMAP = INTEGER INPUT VARIABLE: C IMAP = 1 FOR LINES(1,1,1) = EXPOSURE MAP. C = 2 FOR LINES(1,1,2) = INTENSITY MAP. C NDIMX = FIRST DIMENSION OF MAP ARRAY (INTEGER INPUT VARIABLE). C NDIMY = SECOND DIMENSION OF MAP ARRAY (INTEGER INPUT VARIABLE). C FACTOR: (LINES(IX,IY,IMAP)) IS COPIED TO AN INTERNAL ARRAY C WHICH IS MULTIPLIED BY FACTOR BEFORE BEING PRINTED. C (REAL INPUT VARIABLE.) C HEADER = HEADER RECORD FROM MAP FILE. (CHARACTER INPUT VARIABLE.) C C COMMON BLOCKS: C COMMON/MINMAX/IXMIN,IXMAX,IYMIN,IYMAX C (THESE ARE THE MIN AND MAX ELEMENTS IN LINES WHICH CONTAIN C USEFUL INFO. THEY CAN BE 1,181,1,91). C C SUBROUTINES CALLED BY MAPPRT: C NONE C SUBROUTINE MAPPRT(LINES,IMAP,NDIMX,NDIMY,FACTOR,HEADER) CHARACTER*80 HEADER REAL LINES(NDIMX,NDIMY,2) DIMENSION KK(102) COMMON/MINMAX/IXMIN,IXMAX,IYMIN,IYMAX WRITE(6,8000) IMAP, HEADER 8000 FORMAT(//,'IMAP =',I3,' - HEADER = ',A80) IF (FACTOR .LT. 1.E-30) FACTOR = 1. DO 100 IYY=1,4 IYB=(IYY-1)*25+1 IYE=IYB+24 IF (IYE.GT.NDIMY) IYE=ndimy IF(IYB.GT.IYMAX) GO TO 100 IF(IYE.LT.IYMIN) GO TO 100 103 WRITE(6,8103)IYY,IYB,IYE,IXMIN,IXMAX,FACTOR 8103 FORMAT('1 NEW SET, IYY ,IYB,IYE,IXMIN,IXMAX = ',5I5, + 10X,'ALL VALUES MULTIPLIED BY ',1PG10.3) WRITE(6,8108) (IY,IY=IYB,IYE) 8108 FORMAT(' ',6X,25(I3,1H*)/) NLINES = 0 DO 99 IX=IXMIN,IXMAX DO 98 IY=IYB,IYE 98 KK(IY) = LINES(IX,IY,IMAP)*FACTOR + 0.5 NLINES = NLINES + 1 IF (MOD(NLINES,54) .NE. 0) GO TO 99 WRITE(6,8098) 8098 FORMAT(1H1) WRITE(6,8108) (IY,IY=IYB,IYE) 99 WRITE(6,8100) IX,(KK(IY),IY=IYB,IYE) 100 CONTINUE 8100 FORMAT (' ',I6,25I4) RETURN END C C SUBROUTINE: REMOVE C AUTHOR: DAVE BURROWS C DATE: OCT 4, 1981 C DESCRIPTION: REMOVE ZEROES PIXELS OF AN INPUT MAP ARRAY. C THIS VERSION OF REMOVE ZEROES ELEMENTS WHICH ARE IN REGIONS C THAT ARE BELIEVED TO BE CONTAMINATED IN THE B AND C BANDS. C IT ONLY WORKS FOR ZERO-CENTERED AITOFF PROJECTIONS. C C USAGE: CALL REMOVE(CENTER,OA,J) C CENTER = CENTER LONGITUDE OF MAP C OA = XRMAP(1,J,IMAP) = REAL ARRAY CONTAINING ONE ROW FROM C MAP FILE (DIMENSION 182). C J = INDEX OF THIS ROW (1-92) C C COMMON BLOCKS: C NONE C C SUBROUTINES CALLED BY REMOVE: C NONE C SUBROUTINE REMOVE(CENTER,OA,J) DIMENSION OA(182),IY(105),IX1(105),IX2(105) C C ARRAYS IY, IX1, AND IX2 CONTAIN PIXEL NUMBERS FOR REMOVAL FROM MAP. C IN ROW IY, ALL PIXELS FROM IX1 TO IX2, INCLUSIVE, WILL BE ZEROED C BY THIS SUBROUTINE. C DATA IY/7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26, + 27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46, + 43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60, + 61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80, + 81,82,83,84,85,86,87,88, + 77,78,79,80,81,82,83,84,85,86,87,88,89, + 79,80,81,82,0,0/ DATA IX1/89,87,85,83,81,80,78,76,74,72,70,69,69,68,68,68, + 67,64,64,64,63,63,63,62,62,62,61,60,59,58,58,57,57,57, + 55,54,54,54,54,54, + 24,24,24,24,24,24,23,23,23,23,23,23,23,23,23,24,24, + 24,24,24,24,24,24,24,25,25,26,26,27,27,30,32,32, + 32,33,34,35,36,37,38,38,42,45,48,52,57, + 86,86,86,86,85,85,86,88,88,88,88,88,88,108,107,105,105,0,0/ DATA IX2/99,117,124,124,128,128,130,130,130,130,130,130,130,130, + 130,130,130,130,130,113,113,113,113,113,113,113,113,113,113, + 115,115,115,116,119,110,110,110,110,110,110, + 34,34,34,33,33,33,32,32,32,32,32,32,32,32,32,32,32,32, + 33,33,34,34,35,35,36,38,38,39,39,39,40,41,42,43,43,44, + 45,47,48,49,51,52,54,56,57,58, + 90,90,91,91,91,96,107,105,103,101,98,93,92, + 112,111,109,108,0,0/ C IF (ABS(CENTER) .GT. 1.E-6) GO TO 800 IF (J .LT. 7) RETURN IF (J .GT. 88) RETURN DO 30 K=1,105 IF (J .NE. IY(K)) GO TO 30 IXLO = IX1(K) IXHI = IX2(K) DO 20 I=IXLO,IXHI 20 OA(I) = 0.0 30 CONTINUE RETURN 800 PRINT 8800,CENTER 8800 FORMAT(' BAD VALUE FOR CENTER FOUND IN REMOVE:', + 1PG10.3,/,' CENTER CAN ONLY BE 0 DEGREES.') STOP 'Bad value for CENTER or invalid projection' END