head	3.4;
access;
symbols;
locks
	cal103:3.4; strict;
comment	@c @;


3.4
date	2004.02.11.00.04.18;	author mcalabre;	state Exp;
branches;
next	3.3;

3.3
date	2003.10.21.08.36.48;	author mcalabre;	state Exp;
branches;
next	3.2;

3.2
date	2003.09.09.05.38.38;	author mcalabre;	state Exp;
branches;
next	3.1;

3.1
date	2003.04.28.04.48.53;	author mcalabre;	state Exp;
branches;
next	3.0;

3.0
date	2003.04.01.05.10.21;	author mcalabre;	state Exp;
branches;
next	;


desc
@Program to test WCSPRT, the high-level WCSLIB routine which prints the
contents of a wcsprm struct.
@


3.4
log
@WCSLIB 3.4
@
text
@*=======================================================================
*
*   WCSLIB 3.4 - an implementation of the FITS WCS convention.
*   Copyright (C) 1995-2004, Mark Calabretta
*
*   This program is free software; you can redistribute it and/or modify
*   it under the terms of the GNU General Public License as published by
*   the Free Software Foundation; either version 2 of the License, or
*   (at your option) any later version.
*
*   This program is distributed in the hope that it will be useful, but
*   WITHOUT ANY WARRANTY; without even the implied warranty of
*   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
*   General Public License for more details.
*
*   You should have received a copy of the GNU General Public License
*   along with this library; if not, write to the Free Software
*   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*
*   Correspondence concerning WCSLIB may be directed to:
*      Internet email: mcalabre@@atnf.csiro.au
*      Postal address: Dr. Mark Calabretta
*                      Australia Telescope National Facility, CSIRO
*                      PO Box 76
*                      Epping NSW 1710
*                      AUSTRALIA
*
*=======================================================================
      PROGRAM TWCSPRT
*-----------------------------------------------------------------------
*
*   TWCSPRT tests WCSPRT which prints the contents of a WCSPRM data
*   structure.
*
*   $Id: twcsprt.f,v 3.3 2003/10/21 08:36:48 mcalabre Exp mcalabre $
*-----------------------------------------------------------------------
*     Number of axes and PV cards.
      INTEGER   NAXIS, NPV
      PARAMETER (NAXIS = 4, NPV = 3)

      INTEGER   I, J, K, PVI(NPV), PVM(NPV), STATUS
      DOUBLE PRECISION CDELT(NAXIS), CRPIX(NAXIS), CRVAL(NAXIS),
     :          LATPOLE, LONPOLE, PC(NAXIS,NAXIS), PV(NPV), RESTFRQ,
     :          RESTWAV
      CHARACTER CTYPE(NAXIS)*72

      INCLUDE 'wcs.inc'
      INTEGER WCS(WCSLEN)

      DATA (CRPIX(I), I=1,NAXIS)
     :             /513D0,   0D0,   0D0,   0D0/
      DATA ((PC(I,J),J=1,NAXIS),I=1,NAXIS)
     :             /1.1D0,   0D0,   0D0,   0D0,
     :                0D0, 1.0D0,   0D0, 0.1D0,
     :                0D0,   0D0, 1.0D0,   0D0,
     :                0D0, 0.2D0,   0D0, 1.0D0/
      DATA (CDELT(I), I=1,NAXIS)
     :             /-9.635265432D-6, 1D0, 1D0, -1D0/
      DATA (CTYPE(I), I=1,NAXIS)
     :             /'WAVE-F2W', 'XLAT-SZP ', 'TIME    ', 'XLON-SZP '/
      DATA (CRVAL(I), I=1,NAXIS)
     :             /0.214982042D0, -30D0, -2D3, 150D0/

      DATA LONPOLE /150D0/
      DATA LATPOLE /999D0/
      DATA RESTFRQ /1.42040575D9/
      DATA RESTWAV /0D0/

      DATA (PVI(K), PVM(K), PV(K), K=1,NPV)
     :             /2, 1, 2D0,
     :              2, 2, 210D0,
     :              2, 3,  60D0/
*-----------------------------------------------------------------------
      STATUS = WCSPUT (WCS, WCS_FLAG, -1, 0, 0)
      STATUS = WCSINI (NAXIS, WCS)

      DO 20 I = 1, NAXIS
         STATUS = WCSPUT (WCS, WCS_CRPIX, CRPIX(I), I, 0)

         DO 10 J = 1, NAXIS
            STATUS = WCSPUT (WCS, WCS_PC, PC(I,J), I, J)
 10      CONTINUE

         STATUS = WCSPUT (WCS, WCS_CDELT, CDELT(I), I, 0)
         STATUS = WCSPUT (WCS, WCS_CTYPE, CTYPE(I), I, 0)
         STATUS = WCSPUT (WCS, WCS_CRVAL, CRVAL(I), I, 0)
 20   CONTINUE

      STATUS = WCSPUT (WCS, WCS_LONPOLE, LONPOLE, 0, 0)
      STATUS = WCSPUT (WCS, WCS_LATPOLE, LATPOLE, 0, 0)

      STATUS = WCSPUT (WCS, WCS_RESTFRQ, RESTFRQ, 0, 0)
      STATUS = WCSPUT (WCS, WCS_RESTWAV, RESTWAV, 0, 0)

      DO 30 K = 1, NPV
         STATUS = WCSPUT (WCS, WCS_PV, PV(K), PVI(K), PVM(K))
 30   CONTINUE

*     Extract information from the FITS header.
      STATUS = WCSSET (WCS)

      WRITE (6, 40)
 40   FORMAT (/,'Testing WCSLIB WCSPRT routine',/,
     :          '-----------------------------',//,
     :          'Contents of WCSPRM data structure:')
      STATUS = WCSPRT(WCS)


      END
@


3.3
log
@WCSLIB 3.3
@
text
@d3 2
a4 2
*   WCSLIB 3.3 - an implementation of the FITS WCS convention.
*   Copyright (C) 1995-2003, Mark Calabretta
d35 1
a35 1
*   $Id: twcsprt.f,v 3.2 2003/09/09 05:38:38 mcalabre Exp mcalabre $
@


3.2
log
@WCSLIB 3.2: set WCS_FLAG = -1 to initialize memory management in WCSINI.
@
text
@d3 1
a3 1
*   WCSLIB 3.2 - an implementation of the FITS WCS convention.
d35 1
a35 1
*   $Id: twcsprt.f,v 3.1 2003/04/28 04:48:53 mcalabre Exp mcalabre $
@


3.1
log
@WCSLIB 3.1
@
text
@d3 1
a3 1
*   WCSLIB 3.1 - an implementation of the FITS WCS convention.
d35 1
a35 1
*   $Id: twcsprt.f,v 3.0 2003/04/01 05:10:21 mcalabre Exp mcalabre $
d74 1
@


3.0
log
@WCSLIB 3.0
@
text
@d3 1
a3 1
*   WCSLIB 3.0 - an implementation of the FITS WCS convention.
d35 1
a35 1
*   $Id$
@
