C @(#)fdtotd.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.INPUT/OUTPUT C Input parameters C A4 real*4 array four dimensional p.s.f. C LPXL integer*4 half-size in pixels C LSBP integer*4 half-size in sub-pixels C LL integer*4 half-size of 2-d p.s.f. C Output parameters C A2 real*4 array two dimensional p.s.f. C----------------------------------------------------------------------- C C SUBROUTINE FDTOTD(A4, A2, LPXL, LSBP, LL) C IMPLICIT NONE INTEGER LPXL INTEGER LSBP INTEGER LL REAL A4((-LPXL):LPXL,(-LPXL):LPXL,(-LSBP):LSBP,(-LSBP):LSBP) REAL A2((-LL):LL,(-LL):LL) C INTEGER I, IK INTEGER J, JL INTEGER K INTEGER L C C DO 10 L = -LSBP , LSBP DO 20 K = -LSBP , LSBP DO 30 J = -LPXL , LPXL JL = J * (2*LSBP+1) - L DO 40 I = -LPXL , LPXL IK = I * (2*LSBP+1) - K A2(IK,JL) = A4(I,J,K,L) 40 CONTINUE 30 CONTINUE 20 CONTINUE 10 CONTINUE C RETURN END