C @(#)filbuf.for 17.1.1.1 (ES0-DMD) 01/25/02 17:15:40 C=========================================================================== C Copyright (C) 1995 European Southern Observatory (ESO) 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 C the 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 C GNU General Public License for more details. C C You should have received a copy of the GNU General Public C License along with this program; if not, write to the Free C Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, C MA 02139, USA. C C Corresponding concerning ESO-MIDAS should be addressed as follows: C Internet e-mail: midas@eso.org C Postal address: European Southern Observatory C Data Management Division C Karl-Schwarzschild-Strasse 2 C D 85748 Garching bei Muenchen C GERMANY C=========================================================================== C C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C.IDENTIFICATION C subroutine FILBUF version 1.0 880827 C A. Kruszewski Warsaw U. Obs. C.PURPOSE C Fill with new data image and mask buffers. C.INPUT/OUTPUT C input arguments: C IMF integer*4 image file logical unit number C A real*4 array image buffer C JAPY integer*4 array array with line pointers C NX integer*4 X image dimension C IXYU integer*4 array limits of accessible area C IUSD integer*4 array limits of used buffer C IBUF integer*4 array limits of buffer C output arguments: C JAPY integer*4 array array with line pointers C IBUF integer*4 array limits of buffer C----------------------------------------------------------------------- C C SUBROUTINE FILBUF(IMF, A, JAPY, NX, IXYU, IUSD, IBUF) C IMPLICIT NONE INTEGER IMF REAL A(1) INTEGER JAPY(1) INTEGER NX INTEGER IXYU(4) INTEGER IUSD(4) INTEGER IBUF(4) INTEGER JOFF , JSWE C INTEGER L , LBUF INTEGER NLPB , NPPL , NPIB C C ****** Calculate number of pixels per line NPPL, C ****** number of lines per buffer NLPB C ****** and number of pixels in buffer NPIB. C c IBS = IBUF(1) c JBS = IBUF(2) c IBE = IBUF(3) c JBE = IBUF(4) c NPPL = IXYU(3) - IXYU(1) + 1 NPPL = IBUF(3) - IBUF(1) + 1 c NLPB = MIN ( NYBUF , NIBUF/NPPL ) NLPB = IBUF(4) - IBUF(2) + 1 NPIB = NPPL * NLPB c IF ( NLPB .LE. IUSD(4)-IUSD(2) ) THEN c NSIZ = INT( SQRT( FLOAT( NPIB ) ) ) c NSIZ = MIN( NYBUF , NSIZ ) c NSIZ = MAX( IUSD(4)-IUSD(2)+1 , NSIZ ) c ITMP = IUSD(2) - ( NSIZ - IUSD(4)+IUSD(2)-1 ) / 2 c IBUF(2) = MIN( IUSD(2) , ITMP ) c IBUF(2) = MAX( IBUF(2) , IXYU(2) ) c IBUF(4) = MAX( IUSD(4) , IBUF(2) + NSIZ - 1 ) c IBUF(4) = MIN( IBUF(4) , IXYU(4) ) c NLPB = IBUF(4) - IBUF(2) + 1 c IF ( NYBUF .LT. NLPB ) PAUSE 'NYBUF too small' c NPPL = NIBUF / NLPB c IMEAN = ( IUSD(1) + IUSD(3) ) / 2 c IBUF(1) = IMEAN - NPPL / 2 c IBUF(1) = MIN( IBUF(1) , IUSD(1) ) c IBUF(1) = MAX( IXYU(1) , IBUF(1) ) c IBUF(3) = IBUF(1) + NPPL - 1 c IBUF(3) = MAX( IBUF(3) , IUSD(3) ) c IBUF(3) = MIN( IXYU(3) , IBUF(3) ) c IF ( NPPL .LE. IBUF(3)-IBUF(1) ) THEN c PAUSE 'too small image buffer' c ELSE c NPPL = IBUF(3) - IBUF(1) + 1 c ENDIF c NPIB = NPPL * NLPB c ELSE c IBUF(1) = IXYU(1) c IBUF(2) = IUSD(2) c IBUF(3) = IXYU(3) c IBUF(4) = MIN( IXYU(4) , IBUF(2)+NLPB-1 ) c ENDIF c IOFF = IBUF(1) - 1 C C ****** Calculate limiting lines to be read JSWS and JSWE, C ****** offset to pointers JOFF, C ****** and number of newly read buffer lines LBUF. C c IF ( IBUF(1) .EQ. IBS .AND. IBUF(3) .EQ. IBE .AND. c & IBUF(2) .LE. JBE .AND. IBUF(2) .GE. JBS ) THEN c JSWS = MAX( JBE+1 , IBUF(2) ) c ELSE c JSWS = IBUF(2) c ENDIF JSWE = IBUF(4) JOFF = IBUF(2) - 1 LBUF = JSWE - JOFF C C ****** Update pointers to buffer lines. C DO 10 L = 1 , LBUF JAPY(L) = MOD( (L+JOFF-1)*NPPL , NPIB ) - IBUF(1) + 1 10 CONTINUE C C ****** Read new lines. C c DO 20 J = JSWS , JSWE c CALL RDILIN ( IMF , 1 , A(JAPY(J-JOFF)+IOFF+1) , NX , c & J , IOFF , NPPL ) c 20 CONTINUE C C ****** Read mask lines. C c DO 30 J = JSWS , JSWE c CALL RDMLIN ( MSF , 1 , MA(JAPY(J-JOFF)+IOFF+1) , c & NX , J , IOFF , NPPL ) c 30 CONTINUE C C ****** Update limits of buffered lines. C c IBUF(2) = JOFF + 1 c IBUF(4) = JSWE c 1000 CONTINUE C RETURN C END