C ++******************************************************************** C * C HISMAP.F ADAPTED FROM HPLAN.FOR ON NOV 8 1986 BY ARDEAN LEITH C BORDERS CHANGED TO SOLID LINES FEB 88 ARDEAN LEITH C CHAR ID PASSED AUG 99 ARDEAN LEITH C * C ********************************************************************** C=* FROM: SPIDER - MODULAR IMAGE PROCESSING SYSTEM. AUTHOR: J.FRANK * C=* Copyright (C) 1985-2005 Health Research Inc. * C=* * C=* HEALTH RESEARCH INCORPORATED (HRI), * C=* ONE UNIVERSITY PLACE, RENSSELAER, NY 12144-3455. * C=* * C=* Email: spider@wadsworth.org * C=* * C=* This program is free software; you can redistribute it and/or * C=* modify it under the terms of the GNU General Public License as * C=* published by the Free Software Foundation; either version 2 of the * C=* License, or (at your option) any later version. * C=* * C=* This program is distributed in the hope that it will be useful, * C=* but WITHOUT ANY WARRANTY; without even the implied warranty of * C=* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * C=* General Public License for more details. * C=* * C=* You should have received a copy of the GNU General Public License * C=* along with this program; if not, write to the * C=* Free Software Foundation, Inc., * C=* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * C=* * C ********************************************************************** C C HISMAP(IDIM,NPTS,JX,JY,X,Y,ID,MOD,NLIGN,NPAGE,PEX,NDAT,NBAND) C PREPARES PLOT FILE C C GRAPH OF NPTS POINTS WITH NLIGN-ROWS, AND NPAGE-PAGES C (IF NLIGN=0, AUTOMATIC DETERMINATION OF NLIGN. NPAGE = 1 TO 8) C WARNING: NPAGE MAY NOT BE MORE THAN 3 WITH MODE 1. C COORDINATES X(*) FOR HORIZONTAL AXIS JX, Y(*) FOR VERTICAL AXIS JY C LABELS ARE IN ID(*), FORMAT A1 IF MOD=1, FORMAT A4 IF MOD=4 C POINTS AT MORE THAN PEX STANDARD DEVIATIONS ARE POSITIONED ON THE C EDGES OF THE GRAPH (SUBROUTINE EPUR4). C IF NOR=1 THE ORIGIN IS ADDED TO THE POINTS TO BE DISPLAYED. C WARNING: X(*), Y(*), ID(NPTS+1) ARE DESTROYED UPON RETURN. C GRAPH IS ABORTED IF MORE THAN 264 POINTS ARE ON THE EDGES, C THE FIRST NHID HIDDEN POINTS ARE PRINTED WITH THEIR COORDINATES. C C CALLED BY: SGRAF1 (IN SGRAP.F) C C23456789012345678901234567890123456789012345678901234567890123456789012 C ********************************************************************** SUBROUTINE HISMAP(IDIM,NPTS,JX,JY,X,Y,ID,MOD,NLIGN,NPAGE,PEX, & NDAT,NBAND) PARAMETER (NHID=200) COMMON /COMMUN/ LD1(NHID),LD2(NHID), EX(48), KLIC(371) CHARACTER * 4 KLAC(371) CHARACTER * 4 LA(8),NA(8) CHARACTER * 1 MA(8) INTEGER FPAGE,FL,FC REAL X(IDIM),Y(IDIM),KKO,LLO,IREM,EY CHARACTER * 7 ID(IDIM) CHARACTER * 4 LDA,LDA2,LDB,LDB2 CHARACTER * 4 IKLAC CHARACTER * 1 NULL DATA MA/'-',' ','|','|','.','+',':','^'/ DATA NA/'----',' ','| ',' |',' . ',' + ',': ',' ^ '/ DATA LDA2/' '/,LDB2/' '/ NULL = CHAR(0) IF (NPAGE .EQ. 0) NPAGE = 1 REWIND NBAND NPTSP1 = NPTS + 1 C CHECK TO SEE THAT NUMBER OF POINTS IS NOT EXCESSIVE IF (NPTSP1 .GT. IDIM) WRITE (NDAT,1130) 1130 FORMAT (/' ','(DIMENSION ERROR IN SUBROUTINE HISMAP )'/) WRITE (NDAT,1110) NPTS, JX, JY, JX, JY 1110 FORMAT (///' ',25X,'MAP OF' ,I6, ' POINTS' , & ' ON AXES' ,I2,' AND' , I2,/' ',130('-')//,' ',21X, & 'AXIS',I2,' /HORIZONTAL' ,10X, 'AXIS',I2,' /VERTICAL' //) C FIND POINTS ON BOUNDARY OF MAP CALL EPUR4(IDIM,NPTS, X,Y,ID, MOD, PEX, KP, KLIC,KODE,NDAT) IF (KODE .EQ. 1) THEN CALL ERRT(101, & '*** MAP ABORTED, MORE THAN 264 POINTS ON FRAME',IDUM) RETURN ENDIF C SET SPECIAL SYMBOLS ACCORDING TO MODE DO K = 1,8 IF (MOD .EQ. 1) THEN LA(K) = MA(K) ELSE LA(K) = NA(K) ENDIF ENDDO ID(NPTSP1) = LA(6) X(NPTSP1) = 0.0 Y(NPTSP1) = 0.0 20 CALL BORNS (NPTSP1,X,XMINT,XMAXT) CALL BORNS (NPTSP1,Y,YMINT,YMAXT) C FIND NUMBER OF POSITIONS ON A LINE OF A PAGE (LENP) IF (MOD .EQ. 1) THEN LENP = 123 ELSEIF (MOD .EQ. 4) THEN LENP = 30 END IF C FIND TOTAL NUMBER OF POSITIONS ON A LINE LENTOT = LENP * NPAGE NLINES = NLIGN FC = LENTOT FPAGE = NPAGE C FIND DEFAULT NUMBER OF LINES IF (NLINES .EQ. 0) THEN NLINES = ((YMAXT - YMINT) / (XMAXT - XMINT)) * FPAGE * 74.0 END IF 30 IF (NLINES .LE. 12) NLINES = 12 FL = NLINES S = (XMAXT - XMINT) / FC T = (YMAXT - YMINT) / FL NINT = 5 * NPAGE + 1 ESPX = FC / (5.0 * FPAGE) DO J = 1,NINT C FIND X AXIS LABELS EX(J) = XMINT + S * ESPX * FLOAT(J-1) ENDDO KKO = 0.50001 - (XMINT / S) LLO = 0.50001 + ABS(YMAXT / T) DO I = 1,NPTSP1 C SCALE EACH POINT TO FIT PAGE K = (X(I) - XMINT) / S + 0.500001 L = (YMAXT - Y(I)) / T + 0.500001 C PUT SCALED POINT IN X,Y IF (K .EQ. 0) K = 1 IF (L .EQ. 0) L = 1 X(I) = K + 0.0001 Y(I) = L + 0.0001 ENDDO NSTACKED = 0 DO LL = 1,NLINES C PREPARE EACH LINE, EY IS Y AXIS LABEL EY = YMAXT - T * FLOAT(LL-1) DO KK = 1,LENTOT C FILL OUTPUT LINE WITH BLANKS EXCEPT FOR FIRST, LAST, ETC. LINE KLIC(KK) = 0 KLAC(KK) = LA(2) IF (LL .EQ. 1 .OR. LL .EQ. NLINES) KLAC(KK) = LA(1) IF (KK .EQ. KKO .OR. LL .EQ. LLO) KLAC(KK) = LA(5) ENDDO KLAC(1) = LA(3) KLAC(LENTOT) = LA(4) KLAC(LENTOT + 1) = LA(2) KLIC(LENTOT + 1) = 0 KLIC(LENTOT+2) = 0 DO I = 1,NPTSP1 C PUT EACH POINT ID ON THE PAGE MAP, KLIC(K) HOLDS POINT ID L = Y(I) IF (L .EQ. LL) THEN K = X(I) IF (KLIC(K) .EQ. 0) THEN C PUT NUMBER OF POINT IN KLIC KLIC(K) = I ELSE C ALREADY HAVE POINT AT THIS LOCATION IK = KLIC(K) NSTACKED = NSTACKED + 1 C for pixel map, obviously, nhid=200 is not enough.