head	8.7;
access;
symbols;
locks; strict;
comment	@c @;


8.7
date	2026.05.11.12.01.11;	author mcalabre;	state Exp;
branches;
next	8.6;

8.6
date	2026.03.29.13.53.57;	author mcalabre;	state Exp;
branches
	8.6.1.1;
next	8.5;

8.5
date	2025.12.06.13.47.41;	author mcalabre;	state Exp;
branches
	8.5.1.1;
next	8.4;

8.4
date	2024.10.28.13.56.17;	author mcalabre;	state Exp;
branches
	8.4.1.1;
next	8.3;

8.3
date	2024.05.13.16.33.01;	author mcalabre;	state Exp;
branches
	8.3.1.1;
next	8.2;

8.2
date	2023.11.16.10.00.30;	author mcalabre;	state Exp;
branches
	8.2.1.1;
next	8.1;

8.1
date	2023.07.05.17.12.07;	author mcalabre;	state Exp;
branches
	8.1.1.1;
next	8.0;

8.0
date	2023.07.01.06.15.05;	author mcalabre;	state Exp;
branches
	8.0.1.1;
next	7.13;

7.13
date	2022.10.07.03.43.35;	author mcalabre;	state Exp;
branches
	7.13.1.1;
next	7.12;

7.12
date	2022.09.09.04.57.58;	author mcalabre;	state Exp;
branches
	7.12.1.1;
next	7.11;

7.11
date	2022.04.26.06.13.52;	author mcalabre;	state Exp;
branches
	7.11.1.1;
next	7.10;

7.10
date	2022.04.23.14.25.15;	author mcalabre;	state Exp;
branches
	7.10.1.1;
next	7.9;

7.9
date	2022.03.25.15.14.49;	author mcalabre;	state Exp;
branches
	7.9.1.1;
next	7.8;

7.8
date	2022.03.25.06.11.49;	author mcalabre;	state Exp;
branches
	7.8.1.1;
next	7.7;

7.7
date	2021.07.12.06.36.49;	author mcalabre;	state Exp;
branches
	7.7.1.1;
next	7.6;

7.6
date	2021.04.13.12.57.02;	author mcalabre;	state Exp;
branches
	7.6.1.1;
next	7.5;

7.5
date	2021.03.20.05.54.58;	author mcalabre;	state Exp;
branches
	7.5.1.1;
next	7.4;

7.4
date	2021.01.31.02.24.52;	author mcalabre;	state Exp;
branches
	7.4.1.1;
next	7.3;

7.3
date	2020.06.03.03.37.03;	author mcalabre;	state Exp;
branches
	7.3.1.1;
next	7.2;

7.2
date	2020.03.09.07.31.24;	author mcalabre;	state Exp;
branches
	7.2.1.1;
next	7.1;

7.1
date	2019.12.31.13.25.19;	author mcalabre;	state Exp;
branches
	7.1.1.1;
next	6.4;

6.4
date	2019.08.15.09.30.18;	author mcalabre;	state Exp;
branches
	6.4.1.1;
next	6.3;

6.3
date	2019.07.12.07.33.40;	author mcalabre;	state Exp;
branches
	6.3.1.1;
next	6.2;

6.2
date	2018.10.20.10.03.14;	author mcalabre;	state Exp;
branches
	6.2.1.1;
next	6.1;

6.1
date	2018.10.19.08.35.17;	author mcalabre;	state Exp;
branches
	6.1.1.1;
next	5.20;

5.20
date	2018.10.05.05.32.42;	author mcalabre;	state Exp;
branches
	5.20.1.1;
next	5.19;

5.19
date	2018.07.26.15.37.05;	author mcalabre;	state Exp;
branches
	5.19.1.1;
next	5.18;

5.18
date	2018.01.10.08.32.14;	author mcalabre;	state Exp;
branches
	5.18.1.1;
next	5.17;

5.17
date	2017.09.18.08.44.24;	author mcalabre;	state Exp;
branches
	5.17.1.1;
next	5.16;

5.16
date	2017.01.15.04.25.03;	author mcalabre;	state Exp;
branches
	5.16.1.1;
next	5.15;

5.15
date	2016.04.05.12.55.12;	author mcalabre;	state Exp;
branches
	5.15.1.1;
next	5.14;

5.14
date	2016.02.07.10.49.32;	author mcalabre;	state Exp;
branches
	5.14.1.1;
next	5.13;

5.13
date	2016.01.26.08.51.16;	author mcalabre;	state Exp;
branches
	5.13.1.1;
next	5.12;

5.12
date	2015.11.15.02.13.02;	author mcalabre;	state Exp;
branches
	5.12.1.1;
next	5.11;

5.11
date	2015.10.18.09.13.07;	author mcalabre;	state Exp;
branches
	5.11.1.1;
next	5.10;

5.10
date	2015.10.09.08.19.17;	author mcalabre;	state Exp;
branches
	5.10.1.1;
next	5.9;

5.9
date	2015.07.21.09.20.04;	author mcalabre;	state Exp;
branches
	5.9.1.1;
next	5.8;

5.8
date	2015.07.08.11.04.02;	author mcalabre;	state Exp;
branches
	5.8.1.1;
next	5.7;

5.7
date	2015.06.29.02.44.18;	author mcalabre;	state Exp;
branches
	5.7.1.1;
next	5.6;

5.6
date	2015.06.14.07.11.26;	author mcalabre;	state Exp;
branches
	5.6.1.1;
next	5.5;

5.5
date	2015.05.05.13.16.33;	author mcalabre;	state Exp;
branches
	5.5.1.1;
next	5.4;

5.4
date	2015.04.21.14.41.07;	author mcalabre;	state Exp;
branches
	5.4.1.1;
next	5.3;

5.3
date	2015.04.21.02.50.53;	author mcalabre;	state Exp;
branches
	5.3.1.1;
next	5.2;

5.2
date	2015.04.15.12.35.09;	author mcalabre;	state Exp;
branches
	5.2.1.1;
next	5.1;

5.1
date	2015.04.07.10.56.38;	author mcalabre;	state Exp;
branches
	5.1.1.1;
next	5.0;

5.0
date	2015.04.05.12.25.02;	author mcalabre;	state Exp;
branches
	5.0.1.1;
next	4.25;

4.25
date	2014.12.14.14.29.38;	author mcalabre;	state Exp;
branches
	4.25.1.1;
next	4.24;

4.24
date	2014.09.18.15.25.02;	author mcalabre;	state Exp;
branches
	4.24.1.1;
next	4.23;

4.23
date	2014.05.13.05.50.53;	author mcalabre;	state Exp;
branches
	4.23.1.1;
next	4.22;

4.22
date	2014.04.12.15.03.53;	author mcalabre;	state Exp;
branches
	4.22.1.1;
next	4.21;

4.21
date	2014.03.24.05.12.29;	author mcalabre;	state Exp;
branches
	4.21.1.1;
next	4.20;

4.20
date	2013.12.18.05.42.50;	author mcalabre;	state Exp;
branches
	4.20.1.1;
next	4.19;

4.19
date	2013.09.29.14.17.53;	author mcalabre;	state Exp;
branches
	4.19.1.1;
next	4.18;

4.18
date	2013.07.13.10.00.06;	author mcalabre;	state Exp;
branches
	4.18.1.1;
next	4.17;

4.17
date	2013.01.29.05.29.22;	author cal103;	state Exp;
branches
	4.17.1.1;
next	4.16;

4.16
date	2012.11.07.04.42.45;	author cal103;	state Exp;
branches
	4.16.1.1;
next	4.15;

4.15
date	2012.09.26.14.26.06;	author cal103;	state Exp;
branches
	4.15.1.1;
next	4.14;

4.14
date	2012.07.13.10.02.42;	author cal103;	state Exp;
branches
	4.14.1.1;
next	4.13;

4.13
date	2012.03.14.07.39.31;	author cal103;	state Exp;
branches
	4.13.1.1;
next	4.12;

4.12
date	2012.02.29.07.57.57;	author cal103;	state Exp;
branches
	4.12.1.1;
next	4.11;

4.11
date	2012.02.20.23.30.03;	author cal103;	state Exp;
branches
	4.11.1.1;
next	4.10;

4.10
date	2012.02.05.23.41.44;	author cal103;	state Exp;
branches
	4.10.1.1;
next	4.9;

4.9
date	2012.01.24.05.40.30;	author cal103;	state Exp;
branches
	4.9.1.1;
next	4.8;

4.8
date	2011.08.15.08.05.54;	author cal103;	state Exp;
branches
	4.8.1.1;
next	4.7;

4.7
date	2011.02.07.07.03.43;	author cal103;	state Exp;
branches
	4.7.1.1;
next	4.6;

4.6
date	2010.11.16.06.15.32;	author cal103;	state Exp;
branches
	4.6.1.1;
next	4.5;

4.5
date	2010.07.16.07.01.26;	author cal103;	state Exp;
branches
	4.5.1.1;
next	4.4;

4.4
date	2009.08.06.07.52.43;	author cal103;	state Exp;
branches
	4.4.1.1;
next	4.3;

4.3
date	2007.12.27.05.42.52;	author cal103;	state Exp;
branches
	4.3.1.1;
next	4.2;

4.2
date	2005.09.21.13.37.53;	author cal103;	state Exp;
branches
	4.2.1.1;
next	4.1;

4.1
date	2005.08.26.13.50.14;	author cal103;	state Exp;
branches;
next	4.0;

4.0
date	2005.02.04.12.45.34;	author cal103;	state Exp;
branches;
next	3.6;

3.6
date	2004.08.25.06.33.14;	author cal103;	state Exp;
branches;
next	3.5;

3.5
date	2004.06.28.04.51.50;	author mcalabre;	state Exp;
branches;
next	3.4;

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.03.54.37;	author mcalabre;	state Exp;
branches;
next	3.1;

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

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

4.2.1.1
date	2005.12.05.01.37.43;	author cal103;	state Exp;
branches;
next	4.2.1.2;

4.2.1.2
date	2007.07.05.07.15.16;	author cal103;	state Exp;
branches;
next	4.2.1.3;

4.2.1.3
date	2007.08.02.06.40.51;	author cal103;	state Exp;
branches;
next	4.2.1.4;

4.2.1.4
date	2007.12.03.05.37.50;	author cal103;	state Exp;
branches;
next	;

4.3.1.1
date	2007.12.27.13.25.35;	author cal103;	state Exp;
branches;
next	4.3.1.2;

4.3.1.2
date	2009.07.22.07.28.07;	author cal103;	state Exp;
branches;
next	4.3.1.3;

4.3.1.3
date	2009.08.06.02.50.21;	author cal103;	state Exp;
branches;
next	;

4.4.1.1
date	2009.08.10.08.55.07;	author cal103;	state Exp;
branches;
next	4.4.1.2;

4.4.1.2
date	2010.01.19.03.44.57;	author cal103;	state Exp;
branches;
next	4.4.1.3;

4.4.1.3
date	2010.07.14.04.49.59;	author cal103;	state Exp;
branches;
next	;

4.5.1.1
date	2010.07.16.07.05.32;	author cal103;	state Exp;
branches;
next	;

4.6.1.1
date	2010.11.16.06.16.19;	author cal103;	state Exp;
branches;
next	4.6.1.2;

4.6.1.2
date	2011.01.14.06.34.16;	author cal103;	state Exp;
branches;
next	4.6.1.3;

4.6.1.3
date	2011.01.27.01.21.42;	author cal103;	state Exp;
branches;
next	;

4.7.1.1
date	2011.02.07.07.04.23;	author cal103;	state Exp;
branches;
next	4.7.1.2;

4.7.1.2
date	2011.08.12.14.31.25;	author cal103;	state Exp;
branches;
next	;

4.8.1.1
date	2011.08.15.08.07.07;	author cal103;	state Exp;
branches;
next	4.8.1.2;

4.8.1.2
date	2011.08.16.01.34.41;	author cal103;	state Exp;
branches;
next	4.8.1.3;

4.8.1.3
date	2012.01.24.05.24.12;	author cal103;	state Exp;
branches;
next	;

4.9.1.1
date	2012.01.24.05.41.46;	author cal103;	state Exp;
branches;
next	;

4.10.1.1
date	2012.02.05.23.42.47;	author cal103;	state Exp;
branches;
next	;

4.11.1.1
date	2012.02.20.23.31.14;	author cal103;	state Exp;
branches;
next	;

4.12.1.1
date	2012.02.29.07.59.11;	author cal103;	state Exp;
branches;
next	;

4.13.1.1
date	2012.03.14.07.40.38;	author cal103;	state Exp;
branches;
next	4.13.1.2;

4.13.1.2
date	2012.07.13.03.41.54;	author cal103;	state Exp;
branches;
next	;

4.14.1.1
date	2012.07.13.10.04.58;	author cal103;	state Exp;
branches;
next	;

4.15.1.1
date	2012.09.26.14.27.52;	author cal103;	state Exp;
branches;
next	;

4.16.1.1
date	2012.11.07.04.45.57;	author cal103;	state Exp;
branches;
next	4.16.1.2;

4.16.1.2
date	2013.01.29.05.11.18;	author cal103;	state Exp;
branches;
next	;

4.17.1.1
date	2013.01.29.05.32.33;	author cal103;	state Exp;
branches;
next	;

4.18.1.1
date	2013.07.13.10.02.39;	author mcalabre;	state Exp;
branches;
next	;

4.19.1.1
date	2013.09.29.14.20.40;	author mcalabre;	state Exp;
branches;
next	;

4.20.1.1
date	2013.12.18.05.46.56;	author mcalabre;	state Exp;
branches;
next	4.20.1.2;

4.20.1.2
date	2014.03.21.06.41.05;	author mcalabre;	state Exp;
branches;
next	;

4.21.1.1
date	2014.03.24.05.15.30;	author mcalabre;	state Exp;
branches;
next	;

4.22.1.1
date	2014.04.12.15.06.34;	author mcalabre;	state Exp;
branches;
next	;

4.23.1.1
date	2014.05.13.05.53.51;	author mcalabre;	state Exp;
branches;
next	;

4.24.1.1
date	2014.09.18.15.28.12;	author mcalabre;	state Exp;
branches;
next	;

4.25.1.1
date	2014.12.14.14.32.47;	author mcalabre;	state Exp;
branches;
next	4.25.1.2;

4.25.1.2
date	2015.01.06.01.02.37;	author mcalabre;	state Exp;
branches;
next	;

5.0.1.1
date	2015.04.05.12.28.03;	author mcalabre;	state Exp;
branches;
next	;

5.1.1.1
date	2015.04.07.11.01.12;	author mcalabre;	state Exp;
branches;
next	;

5.2.1.1
date	2015.04.15.12.39.18;	author mcalabre;	state Exp;
branches;
next	;

5.3.1.1
date	2015.04.21.02.54.05;	author mcalabre;	state Exp;
branches;
next	;

5.4.1.1
date	2015.04.21.14.44.31;	author mcalabre;	state Exp;
branches;
next	;

5.5.1.1
date	2015.05.05.13.21.03;	author mcalabre;	state Exp;
branches;
next	;

5.6.1.1
date	2015.06.14.07.14.47;	author mcalabre;	state Exp;
branches;
next	;

5.7.1.1
date	2015.06.29.02.47.26;	author mcalabre;	state Exp;
branches;
next	;

5.8.1.1
date	2015.07.08.11.07.22;	author mcalabre;	state Exp;
branches;
next	;

5.9.1.1
date	2015.07.21.09.28.11;	author mcalabre;	state Exp;
branches;
next	;

5.10.1.1
date	2015.10.09.08.22.39;	author mcalabre;	state Exp;
branches;
next	;

5.11.1.1
date	2015.10.18.09.16.30;	author mcalabre;	state Exp;
branches;
next	;

5.12.1.1
date	2015.11.15.02.16.17;	author mcalabre;	state Exp;
branches;
next	5.12.1.2;

5.12.1.2
date	2016.01.25.05.21.36;	author mcalabre;	state Exp;
branches;
next	;

5.13.1.1
date	2016.01.26.08.54.35;	author mcalabre;	state Exp;
branches;
next	;

5.14.1.1
date	2016.02.07.10.52.48;	author mcalabre;	state Exp;
branches;
next	;

5.15.1.1
date	2016.04.05.12.58.38;	author mcalabre;	state Exp;
branches;
next	5.15.1.2;

5.15.1.2
date	2017.01.15.04.08.23;	author mcalabre;	state Exp;
branches;
next	;

5.16.1.1
date	2017.01.15.04.29.03;	author mcalabre;	state Exp;
branches;
next	;

5.17.1.1
date	2017.09.18.08.46.00;	author mcalabre;	state Exp;
branches;
next	5.17.1.2;

5.17.1.2
date	2018.01.10.08.26.53;	author mcalabre;	state Exp;
branches;
next	;

5.18.1.1
date	2018.01.10.08.33.04;	author mcalabre;	state Exp;
branches;
next	;

5.19.1.1
date	2018.07.26.15.41.42;	author mcalabre;	state Exp;
branches;
next	;

5.20.1.1
date	2018.10.05.05.33.33;	author mcalabre;	state Exp;
branches;
next	5.20.1.2;

5.20.1.2
date	2018.10.19.05.18.12;	author mcalabre;	state Exp;
branches;
next	;

6.1.1.1
date	2018.10.19.08.36.15;	author mcalabre;	state Exp;
branches;
next	;

6.2.1.1
date	2018.10.20.10.04.15;	author mcalabre;	state Exp;
branches;
next	6.2.1.2;

6.2.1.2
date	2019.05.10.02.08.35;	author mcalabre;	state Exp;
branches;
next	6.2.1.3;

6.2.1.3
date	2019.07.07.13.39.29;	author mcalabre;	state Exp;
branches;
next	;

6.3.1.1
date	2019.07.12.07.34.37;	author mcalabre;	state Exp;
branches;
next	;

6.4.1.1
date	2019.08.15.09.31.29;	author mcalabre;	state Exp;
branches;
next	6.4.1.2;

6.4.1.2
date	2019.12.31.02.52.22;	author mcalabre;	state Exp;
branches;
next	6.4.1.3;

6.4.1.3
date	2019.12.31.03.29.14;	author mcalabre;	state Exp;
branches;
next	;

7.1.1.1
date	2019.12.31.13.28.19;	author mcalabre;	state Exp;
branches;
next	;

7.2.1.1
date	2020.03.09.07.34.50;	author mcalabre;	state Exp;
branches;
next	7.2.1.2;

7.2.1.2
date	2020.05.07.03.47.32;	author mcalabre;	state Exp;
branches;
next	;

7.3.1.1
date	2020.06.03.03.38.11;	author mcalabre;	state Exp;
branches;
next	7.3.1.2;

7.3.1.2
date	2021.01.19.14.11.08;	author mcalabre;	state Exp;
branches;
next	7.3.1.3;

7.3.1.3
date	2021.01.28.12.32.09;	author mcalabre;	state Exp;
branches;
next	;

7.4.1.1
date	2021.01.31.02.26.24;	author mcalabre;	state Exp;
branches;
next	;

7.5.1.1
date	2021.03.20.05.56.42;	author mcalabre;	state Exp;
branches;
next	;

7.6.1.1
date	2021.04.13.13.00.36;	author mcalabre;	state Exp;
branches;
next	7.6.1.2;

7.6.1.2
date	2021.07.02.06.41.29;	author mcalabre;	state Exp;
branches;
next	;

7.7.1.1
date	2021.07.12.06.38.28;	author mcalabre;	state Exp;
branches;
next	7.7.1.2;

7.7.1.2
date	2022.03.25.06.06.00;	author mcalabre;	state Exp;
branches;
next	;

7.8.1.1
date	2022.03.25.06.14.15;	author mcalabre;	state Exp;
branches;
next	;

7.9.1.1
date	2022.03.25.15.16.40;	author mcalabre;	state Exp;
branches;
next	;

7.10.1.1
date	2022.04.23.14.26.54;	author mcalabre;	state Exp;
branches;
next	;

7.11.1.1
date	2022.04.26.06.15.33;	author mcalabre;	state Exp;
branches;
next	;

7.12.1.1
date	2022.09.09.05.00.36;	author mcalabre;	state Exp;
branches;
next	;

7.13.1.1
date	2022.10.07.03.45.47;	author mcalabre;	state Exp;
branches;
next	7.13.1.2;

7.13.1.2
date	2023.06.15.04.17.21;	author mcalabre;	state Exp;
branches;
next	;

8.0.1.1
date	2023.07.01.06.22.44;	author mcalabre;	state Exp;
branches;
next	8.0.1.2;

8.0.1.2
date	2023.07.04.15.11.44;	author mcalabre;	state Exp;
branches;
next	;

8.1.1.1
date	2023.07.05.17.15.01;	author mcalabre;	state Exp;
branches;
next	;

8.2.1.1
date	2023.11.16.10.05.58;	author mcalabre;	state Exp;
branches;
next	8.2.1.2;

8.2.1.2
date	2024.04.02.14.06.12;	author mcalabre;	state Exp;
branches;
next	8.2.1.3;

8.2.1.3
date	2024.05.06.15.33.00;	author mcalabre;	state Exp;
branches;
next	;

8.3.1.1
date	2024.05.13.16.35.40;	author mcalabre;	state Exp;
branches;
next	;

8.4.1.1
date	2024.10.28.13.58.42;	author mcalabre;	state Exp;
branches;
next	8.4.1.2;

8.4.1.2
date	2025.12.06.13.37.19;	author mcalabre;	state Exp;
branches;
next	;

8.5.1.1
date	2025.12.06.14.05.16;	author mcalabre;	state Exp;
branches;
next	8.5.1.2;

8.5.1.2
date	2026.03.29.13.36.19;	author mcalabre;	state Exp;
branches;
next	;

8.6.1.1
date	2026.03.29.14.19.27;	author mcalabre;	state Exp;
branches;
next	;


desc
@Program to test closure of the WCSLIB spectral coordinate transformation
routines and also plot the non-linear deviation (requires PGPLOT and X11).
@


8.7
log
@WCSLIB 8.7
@
text
@*=======================================================================
*
* WCSLIB 8.7 - an implementation of the FITS WCS standard.
* Copyright (C) 1995-2026, Mark Calabretta
*
* This file is part of WCSLIB.
*
* WCSLIB is free software: you can redistribute it and/or modify it
* under the terms of the GNU Lesser General Public License as published
* by the Free Software Foundation, either version 3 of the License, or
* (at your option) any later version.
*
* WCSLIB 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 Lesser General Public
* License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with WCSLIB.  If not, see http://www.gnu.org/licenses.
*
* Author: Mark Calabretta, Australia Telescope National Facility, CSIRO.
* http://www.atnf.csiro.au/computing/software/wcs
* $Id: tspc.f,v 8.6.1.1 2026/03/29 14:19:27 mcalabre Exp mcalabre $
*=======================================================================

      PROGRAM TSPC
*-----------------------------------------------------------------------
*
* TSPC tests the spectral transformation driver routines for closure.
*
*-----------------------------------------------------------------------
*     Maximum length of spectral axis - see CLOSURE.
      INTEGER   NSPEC
      PARAMETER (NSPEC = 8001)

      INTEGER   CLOSURE, NAXISJ, NFAIL
      DOUBLE PRECISION C, CDELTX, CRPIXJ, CRVALX, MARS(0:6), RESTFRQ,
     :          RESTWAV, X1, X2

      COMMON /SPECTRO/ MARS

      DATA C /2.99792458D8/

*     KPNO MARS spectrograph grism parameters.
      DATA MARS /4.5D5, 1D0, 27D0, 1.765D0, -1.077D6, 3D0, 5D0/
*-----------------------------------------------------------------------
      WRITE (*, 10)
 10   FORMAT ('Testing closure of WCSLIB spectral transformation ',
     :        'routines (tspc.f)',/,
     :        '--------------------------------------------------',
     :        '-----------------')

      NFAIL = 0

*     PGPLOT initialization.
      CALL PGBEG (0, '/xwindow', 1, 1)

      NAXISJ = NSPEC
      CRPIXJ = NAXISJ/2 + 1

      RESTFRQ = 1420.40595D6
      RESTWAV = C/RESTFRQ
      X1 = 1D9
      X2 = 2D9
      CDELTX = (X2 - X1)/(NAXISJ - 1)
      CRVALX = X1 + (CRPIXJ - 1.0)*CDELTX
      WRITE (*, 20) X1*1D-9, X2*1D-9, CDELTX*1D-3
 20   FORMAT (/,'Linear frequency axis, span:',F4.1,' to',F4.1,
     :        ' (GHz), step:',F8.3,' (kHz)',/,'---------------------',
     :        '-----------------------------------------------------')
      NFAIL = NFAIL + CLOSURE('WAVE-F2W', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('VOPT-F2W', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('ZOPT-F2W', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('AWAV-F2A', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('VELO-F2V', RESTFRQ, 0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('BETA-F2V', RESTFRQ, 0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)


      RESTWAV = 700D-9
      RESTFRQ = C/RESTWAV
      X1 = 300D-9
      X2 = 900D-9
      CDELTX = (X2 - X1)/(NAXISJ - 1)
      CRVALX = X1 + (CRPIXJ - 1D0)*CDELTX
      WRITE (*, 30) INT(X1*1D9), INT(X2*1D9), CDELTX*1D9
 30   FORMAT (/,'Linear vacuum wavelength axis, span:',I4,' to',I4,
     :        ' (nm), step:',F9.6,' (nm)',/,'----------------------',
     :        '----------------------------------------------------')
      NFAIL = NFAIL + CLOSURE('FREQ-W2F', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('AFRQ-W2F', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('ENER-W2F', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('WAVN-W2F', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('VRAD-W2F', RESTFRQ, 0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('AWAV-W2A', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('VELO-W2V', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('BETA-W2V', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)


      WRITE (*, 40) INT(X1*1D9), INT(X2*1D9), CDELTX*1D9
 40   FORMAT (/,'Linear air wavelength axis, span:',I4,' to',I4,
     :        ' (nm), step:',F9.6,' (nm)',/,'----------------------',
     :        '----------------------------------------------------')
      NFAIL = NFAIL + CLOSURE('FREQ-A2F', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('AFRQ-A2F', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('ENER-A2F', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('WAVN-A2F', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('VRAD-A2F', RESTFRQ, 0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('WAVE-A2W', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('VOPT-A2W', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('ZOPT-A2W', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('VELO-A2V', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('BETA-A2V', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)


      RESTFRQ = 1420.40595D6
      RESTWAV = C/RESTFRQ
      X1 = -0.96D0*C
      X2 =  0.96D0*C
      CDELTX = (X2 - X1)/(NAXISJ - 1)
      CRVALX = X1 + (CRPIXJ - 1D0)*CDELTX
      WRITE (*, 50) INT(X1), INT(X2), INT(CDELTX)
 50   FORMAT (/,'Linear velocity axis, span:',I11,' to',I10,
     :        ' m/s, step:',I6,' (m/s)',/,'-----------------------',
     :        '---------------------------------------------------')
      NFAIL = NFAIL + CLOSURE('FREQ-V2F', RESTFRQ, 0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('AFRQ-V2F', RESTFRQ, 0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('ENER-V2F', RESTFRQ, 0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('WAVN-V2F', RESTFRQ, 0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('VRAD-V2F', RESTFRQ, 0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('WAVE-V2W', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('VOPT-V2W', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('ZOPT-V2W', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('AWAV-V2A', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)


      RESTWAV = 650D-9
      RESTFRQ = C/RESTWAV
      X1 =  300D-9
      X2 = 1000D-9
      CDELTX = (X2 - X1)/(NAXISJ - 1)
      CRVALX = X1 + (CRPIXJ - 1D0)*CDELTX
      WRITE (*, 60) INT(X1*1D9), INT(X2*1D9), CDELTX*1D9
 60   FORMAT (/,'Vacuum wavelength grism axis, span:',I4,' to',I5,
     :        ' (nm), step:',F9.6,' (nm)',/,'----------------------',
     :        '----------------------------------------------------')
      NFAIL = NFAIL + CLOSURE('FREQ-GRI', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('AFRQ-GRI', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('ENER-GRI', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('WAVN-GRI', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('VRAD-GRI', RESTFRQ, 0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('WAVE-GRI', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('VOPT-GRI', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('ZOPT-GRI', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('AWAV-GRI', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('VELO-GRI', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('BETA-GRI', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)


*     Reproduce Fig. 5 of Paper III.
      NAXISJ = 1700
      CRPIXJ = 719.8D0
      CRVALX = 7245.2D-10
      CDELTX = 2.956D-10
      RESTWAV = 8500D-10
      RESTFRQ = C/RESTWAV
      X1 = CRVALX + (1 - CRPIXJ)*CDELTX
      X2 = CRVALX + (NAXISJ - CRPIXJ)*CDELTX
      MARS(5) = 0D0
      MARS(6) = 0D0
      WRITE (*, 70) INT(X1*1D9), INT(X2*1D9), CDELTX*1D9
 70   FORMAT (/,'Air wavelength grism axis, span:',I4,' to',I5,
     :        ' (nm), step:',F9.6,' (nm)',/,'----------------------',
     :        '----------------------------------------------------')
      NFAIL = NFAIL + CLOSURE('AWAV-GRA', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('VELO-GRA', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)

      CALL PGASK(0)
      CALL PGEND()


      IF (NFAIL.NE.0) THEN
        WRITE (*, 80) NFAIL
 80     FORMAT (/,'FAIL:',I5,' closure residuals exceed reporting ',
     :    'tolerance.')
      ELSE
        WRITE (*, 90)
 90     FORMAT (/,'PASS: All closure residuals are within reporting ',
     :    'tolerance.')
      END IF

      END

*=======================================================================

      INTEGER FUNCTION CLOSURE (CTYPES, RESTFRQ, RESTWAV, NAXISJ,
     :  CRPIXJ, CDELTX, CRVALX)

      INTEGER   NSPEC
      PARAMETER (NSPEC = 8001)

      INTEGER   J, NAXISJ, NFAIL, RESTREQ, STAT1(NSPEC), STAT2(NSPEC),
     :          STATUS
      REAL      TMP, X(NSPEC), XMIN, XMAX, Y(NSPEC), YMAX, YMIN
      DOUBLE PRECISION CDELTS, CDELTX, CLOS(NSPEC), CRPIXJ, CRVALS,
     :          CRVALX, DSDX, MARS(0:6), RESID, RESIDMAX, RESTFRQ,
     :          RESTWAV, SPEC1(NSPEC), SPEC2(NSPEC), TOL
      CHARACTER CTYPES*8, PTYPE, SCODE*3, SNAME*21, STYPE*8, TITLE*80,
     :          UNITS*7, XTYPE, YLAB*80

*     On some systems, such as Sun Sparc, the struct MUST be aligned
*     on a double precision boundary, done here using an equivalence.
*     Failure to do this may result in mysterious "bus errors".
      INCLUDE 'spx.inc'
      INCLUDE 'spc.inc'
      INTEGER   SPC(SPCLEN)
      DOUBLE PRECISION DUMMY
      EQUIVALENCE (SPC,DUMMY)

      COMMON /SPECTRO/ MARS

      DATA TOL /1D-11/
*-----------------------------------------------------------------------
      CLOSURE = 0

*     Get keyvalues for the required spectral axis type.
      STATUS = SPCXPS (CTYPES, CRVALX, RESTFRQ, RESTWAV, PTYPE, XTYPE,
     :                 RESTREQ, CRVALS, DSDX)
      IF (STATUS.NE.0) THEN
        WRITE (*, 10) STATUS, CTYPES
 10     FORMAT ('ERROR',I2,' from SPCXPS for',A,'.')
        RETURN
      END IF
      CDELTS = CDELTX * DSDX

      STATUS = SPCINI(SPC)

      IF (CTYPES(6:6).EQ.'G') THEN
*       KPNO MARS spectrograph grism parameters.
        STATUS = SPCPTD (SPC, SPC_PV, MARS(0), 0)
        STATUS = SPCPTD (SPC, SPC_PV, MARS(1), 1)
        STATUS = SPCPTD (SPC, SPC_PV, MARS(2), 2)
        STATUS = SPCPTD (SPC, SPC_PV, MARS(3), 3)
        STATUS = SPCPTD (SPC, SPC_PV, MARS(4), 4)
        STATUS = SPCPTD (SPC, SPC_PV, MARS(5), 5)
        STATUS = SPCPTD (SPC, SPC_PV, MARS(6), 6)
      END IF

*     Construct the axis.
      DO 20 J = 1, NAXISJ
        SPEC1(J) = (J - CRPIXJ)*CDELTS
 20   CONTINUE

      WRITE (*, 30) CTYPES, CRVALS+SPEC1(1), CRVALS+SPEC1(NAXISJ),
     :              CDELTS
 30   FORMAT (A,' (CRVALk+w) range: ',1PE13.6,' to ',1PE13.6,', step: ',
     :        1PE13.6)


*     Initialize.
      STATUS = SPCPTI (SPC, SPC_FLAG, 0, 0)
      STATUS = SPCPTD (SPC, SPC_CRVAL, CRVALS, 0)
      STATUS = SPCPTD (SPC, SPC_RESTFRQ, RESTFRQ, 0)
      STATUS = SPCPTD (SPC, SPC_RESTWAV, RESTWAV, 0)
      STATUS = SPCPTC (SPC, SPC_TYPE, CTYPES, 0)
      STATUS = SPCPTC (SPC, SPC_CODE, CTYPES(6:8), 0)

*     Convert the first to the second.
      STATUS = SPCX2S(SPC, NAXISJ, 1, 1, SPEC1, SPEC2, STAT1)
      IF (STATUS.NE.0) THEN
        WRITE (*, 40) STATUS
 40     FORMAT ('SPCX2S ERROR',I2,'.')
        RETURN
      END IF

*     Convert the second back to the first.
      STATUS = SPCS2X(SPC, NAXISJ, 1, 1, SPEC2, CLOS, STAT2)
      IF (STATUS.NE.0) THEN
        WRITE (*, 50) STATUS
 50     FORMAT ('SPCS2X ERROR',I2,'.')
        RETURN
      END IF


*     Test closure.
      NFAIL = 0
      RESIDMAX = 0D0
      STATUS = SPCGTC (SPC, SPC_TYPE, STYPE)
      DO 90 J = 1, NAXISJ
        IF (STAT1(J).NE.0) THEN
          WRITE (*, 60) CTYPES, SPEC1(J), STYPE, STAT1(J)
 60       FORMAT (A,': w =',1PE20.12,' -> ',A4,' = ???, stat = ',I2)
          GO TO 90
        END IF

        IF (STAT2(J).NE.0) THEN
          WRITE (*, 70) CTYPES, SPEC1(J), STYPE, SPEC2(J), STAT2(J)
 70       FORMAT (A,': w =',1PE20.12,' -> ',A4,' =',1PE20.12,
     :            ' -> w = ???, stat = ',I2)
          GO TO 90
        END IF

        RESID = ABS((CLOS(J) - SPEC1(J))/CDELTS)
        IF (RESID.GT.RESIDMAX) RESIDMAX = RESID

        IF (RESID.GT.TOL) THEN
          NFAIL = NFAIL + 1
          WRITE (*, 80) CTYPES, SPEC1(J), STYPE, SPEC2(J), CLOS(J),
     :                  RESID
 80       FORMAT (A,': w =',1PE20.12,' -> ',A4,' =',1PE20.12,' ->',/,
     :           '          w =',1PE20.12,',  resid =',1PE8.1)
        END IF
 90   CONTINUE

      WRITE (*, 100) CTYPES, RESIDMAX
 100  FORMAT (A,': Maximum closure residual =',1PE8.1,' pixel')


*     Draw graph.
      CALL PGBBUF()
      CALL PGERAS()

      XMIN = REAL(CRVALS + SPEC1(1))
      XMAX = REAL(CRVALS + SPEC1(NAXISJ))
      YMIN = REAL(SPEC2(1)) - XMIN
      YMAX = YMIN
      DO 110 J = 1, NAXISJ
        X(J) = REAL(J)
        Y(J) = REAL(SPEC2(J) - (CRVALS + SPEC1(J)))
        IF (Y(J).GT.YMAX) YMAX = Y(J)
        IF (Y(J).LT.YMIN) YMIN = Y(J)
 110  CONTINUE

      J = INT(CRPIXJ+1)
      IF (Y(J).LT.0D0) then
        TMP  = YMIN
        YMIN = YMAX
        YMAX = TMP
      END IF

      CALL PGASK(0)
      CALL PGENV(1.0, REAL(NAXISJ), YMIN, YMAX, 0, -1)

      CALL PGSCI(1)
      CALL PGBOX('ABNTS', 0.0, 0, 'BNTS', 0.0, 0)

      STATUS = SPCTYP (CTYPES, STYPE, SCODE, SNAME, UNITS, PTYPE, XTYPE,
     :                 RESTREQ)
      DO 120 J = 21, 1, -1
        IF (SNAME(J:J).NE.' ') GO TO 130
 120  CONTINUE
 130  YLAB  = SNAME(:J) // ' - correction ' // UNITS
      TITLE = CTYPES // ':  CRVALk + w ' // UNITS
      CALL PGLAB('Pixel coordinate', YLAB, TITLE)

      CALL PGAXIS('N', 0.0, YMAX, REAL(NAXISJ), YMAX, XMIN, XMAX, 0.0,
     :            0, -0.5, 0.0, 0.5, -0.5, 0.0)

      CALL PGAXIS('N', REAL(NAXISJ), ymin, REAL(NAXISJ), YMAX,
     :            REAL(YMIN/CDELTS), REAL(YMAX/CDELTS), 0.0, 0, 0.5,
     :            0.0, 0.5, 0.1, 0.0)
      CALL PGMTXT('R', 2.2, 0.5, 0.5, 'Pixel offset')

      CALL PGLINE(NAXISJ, X, Y)
      CALL PGSCI(7)
      CALL PGPT1(REAL(CRPIXJ), 0.0, 24)
      CALL PGEBUF()

      CALL WCSLEEP (200)
      WRITE (*, '(A,$)') 'Type <RETURN> for next page: '
      READ (*, *, END=140)
 140  WRITE (*, *)

      CLOSURE = NFAIL

      END
@


8.6
log
@WCSLIB 8.6
@
text
@d3 1
a3 1
* WCSLIB 8.6 - an implementation of the FITS WCS standard.
d23 1
a23 1
* $Id: tspc.f,v 8.5.1.2 2026/03/29 13:36:19 mcalabre Exp mcalabre $
@


8.6.1.1
log
@WCSLIB 8.6 development branch.
@
text
@d23 1
a23 1
* $Id: tspc.f,v 8.6 2026/03/29 13:53:57 mcalabre Exp $
@


8.5
log
@WCSLIB 8.5
@
text
@d3 2
a4 2
* WCSLIB 8.5 - an implementation of the FITS WCS standard.
* Copyright (C) 1995-2025, Mark Calabretta
d22 2
a23 2
* http://www.atnf.csiro.au/people/Mark.Calabretta
* $Id: tspc.f,v 8.4.1.2 2025/12/06 13:37:19 mcalabre Exp mcalabre $
@


8.5.1.1
log
@WCSLIB 8.5 development branch.
@
text
@d23 1
a23 1
* $Id: tspc.f,v 8.5 2025/12/06 13:47:41 mcalabre Exp $
@


8.5.1.2
log
@Updated date in copyright notice.
@
text
@d4 1
a4 1
* Copyright (C) 1995-2026, Mark Calabretta
d22 2
a23 2
* http://www.atnf.csiro.au/computing/software/wcs
* $Id: tspc.f,v 8.5.1.1 2025/12/06 14:05:16 mcalabre Exp mcalabre $
@


8.4
log
@WCSLIB 8.4
@
text
@d3 2
a4 2
* WCSLIB 8.4 - an implementation of the FITS WCS standard.
* Copyright (C) 1995-2024, Mark Calabretta
d23 1
a23 1
* $Id: tspc.f,v 8.3.1.1 2024/05/13 16:35:40 mcalabre Exp mcalabre $
@


8.4.1.1
log
@WCSLIB 8.4 development branch.
@
text
@d23 1
a23 1
* $Id: tspc.f,v 8.4 2024/10/28 13:56:17 mcalabre Exp $
@


8.4.1.2
log
@Updated date in copyright notice.
@
text
@d4 1
a4 1
* Copyright (C) 1995-2025, Mark Calabretta
d23 1
a23 1
* $Id: tspc.f,v 8.4.1.1 2024/10/28 13:58:42 mcalabre Exp mcalabre $
@


8.3
log
@WCSLIB 8.3
@
text
@d3 1
a3 1
* WCSLIB 8.3 - an implementation of the FITS WCS standard.
d23 1
a23 1
* $Id: tspc.f,v 8.2.1.3 2024/05/06 15:33:00 mcalabre Exp mcalabre $
@


8.3.1.1
log
@WCSLIB 8.3 development branch.
@
text
@d23 1
a23 1
* $Id: tspc.f,v 8.3 2024/05/13 16:33:01 mcalabre Exp $
@


8.2
log
@WCSLIB 8.2
@
text
@d3 2
a4 2
* WCSLIB 8.2 - an implementation of the FITS WCS standard.
* Copyright (C) 1995-2023, Mark Calabretta
d23 1
a23 1
* $Id: tspc.f,v 8.1.1.1 2023/07/05 17:15:01 mcalabre Exp mcalabre $
d333 1
a333 1
      STATUS = SPCGTC (SPC, SPC_TYPE, STYPE, 0)
@


8.2.1.1
log
@WCSLIB 8.2 development branch.
@
text
@d23 1
a23 1
* $Id: tspc.f,v 8.2 2023/11/16 10:00:30 mcalabre Exp $
@


8.2.1.2
log
@Updated date in copyright notice.
@
text
@d4 1
a4 1
* Copyright (C) 1995-2024, Mark Calabretta
d23 1
a23 1
* $Id: tspc.f,v 8.2.1.1 2023/11/16 10:05:58 mcalabre Exp mcalabre $
@


8.2.1.3
log
@In function CLOSURE, fixed a call to SPCGTC.
@
text
@d23 1
a23 1
* $Id: tspc.f,v 8.2.1.2 2024/04/02 14:06:12 mcalabre Exp mcalabre $
d333 1
a333 1
      STATUS = SPCGTC (SPC, SPC_TYPE, STYPE)
@


8.1
log
@WCSLIB 8.1
@
text
@d3 1
a3 1
* WCSLIB 8.1 - an implementation of the FITS WCS standard.
d23 1
a23 1
* $Id: tspc.f,v 8.0.1.2 2023/07/04 15:11:44 mcalabre Exp mcalabre $
@


8.1.1.1
log
@WCSLIB 8.1 development branch.
@
text
@d23 1
a23 1
* $Id: tspc.f,v 8.1 2023/07/05 17:12:07 mcalabre Exp $
@


8.0
log
@WCSLIB 8.0
@
text
@d3 1
a3 1
* WCSLIB 8.0 - an implementation of the FITS WCS standard.
d23 1
a23 1
* $Id: tspc.f,v 7.13.1.2 2023/06/15 04:17:21 mcalabre Exp mcalabre $
d414 1
@


8.0.1.1
log
@WCSLIB 8.0 development branch.
@
text
@d23 1
a23 1
* $Id: tspc.f,v 8.0 2023/07/01 06:15:05 mcalabre Exp $
@


8.0.1.2
log
@Pause for 200ms between plots using new utility function, WCSLEEP().
@
text
@d23 1
a23 1
* $Id: tspc.f,v 8.0.1.1 2023/07/01 06:22:44 mcalabre Exp mcalabre $
a413 1
      CALL WCSLEEP (200)
@


7.13
log
@WCSLIB 7.13
@
text
@d3 2
a4 2
* WCSLIB 7.13 - an implementation of the FITS WCS standard.
* Copyright (C) 1995-2022, Mark Calabretta
d23 1
a23 1
* $Id: tspc.f,v 7.12.1.1 2022/09/09 05:00:36 mcalabre Exp mcalabre $
@


7.13.1.1
log
@WCSLIB 7.13 development branch.
@
text
@d23 1
a23 1
* $Id: tspc.f,v 7.13 2022/10/07 03:43:35 mcalabre Exp $
@


7.13.1.2
log
@Updated date in copyright notice.
@
text
@d4 1
a4 1
* Copyright (C) 1995-2023, Mark Calabretta
d23 1
a23 1
* $Id: tspc.f,v 7.13.1.1 2022/10/07 03:45:47 mcalabre Exp mcalabre $
@


7.12
log
@WCSLIB 7.12
@
text
@d3 1
a3 1
* WCSLIB 7.12 - an implementation of the FITS WCS standard.
d23 1
a23 1
* $Id: tspc.f,v 7.11.1.1 2022/04/26 06:15:33 mcalabre Exp mcalabre $
@


7.12.1.1
log
@WCSLIB 7.12 development branch.
@
text
@d23 1
a23 1
* $Id: tspc.f,v 7.12 2022/09/09 04:57:58 mcalabre Exp $
@


7.11
log
@WCSLIB 7.11
@
text
@d3 1
a3 1
* WCSLIB 7.11 - an implementation of the FITS WCS standard.
d23 1
a23 1
* $Id: tspc.f,v 7.10.1.1 2022/04/23 14:26:54 mcalabre Exp mcalabre $
@


7.11.1.1
log
@WCSLIB 7.11 development branch.
@
text
@d23 1
a23 1
* $Id: tspc.f,v 7.11 2022/04/26 06:13:52 mcalabre Exp $
@


7.10
log
@WCSLIB 7.10
@
text
@d3 1
a3 1
* WCSLIB 7.10 - an implementation of the FITS WCS standard.
d23 1
a23 1
* $Id: tspc.f,v 7.9.1.1 2022/03/25 15:16:40 mcalabre Exp mcalabre $
@


7.10.1.1
log
@WCSLIB 7.10 development branch.
@
text
@d23 1
a23 1
* $Id: tspc.f,v 7.10 2022/04/23 14:25:15 mcalabre Exp $
@


7.9
log
@WCSLIB 7.9
@
text
@d3 1
a3 1
* WCSLIB 7.9 - an implementation of the FITS WCS standard.
d23 1
a23 1
* $Id: tspc.f,v 7.8.1.1 2022/03/25 06:14:15 mcalabre Exp mcalabre $
@


7.9.1.1
log
@WCSLIB 7.9 development branch.
@
text
@d23 1
a23 1
* $Id: tspc.f,v 7.9 2022/03/25 15:14:49 mcalabre Exp $
@


7.8
log
@WCSLIB 7.8
@
text
@d3 1
a3 1
* WCSLIB 7.8 - an implementation of the FITS WCS standard.
d23 1
a23 1
* $Id: tspc.f,v 7.7.1.2 2022/03/25 06:06:00 mcalabre Exp mcalabre $
@


7.8.1.1
log
@WCSLIB 7.8 development branch.
@
text
@d23 1
a23 1
* $Id: tspc.f,v 7.8 2022/03/25 06:11:49 mcalabre Exp $
@


7.7
log
@WCSLIB 7.7
@
text
@d3 2
a4 2
* WCSLIB 7.7 - an implementation of the FITS WCS standard.
* Copyright (C) 1995-2021, Mark Calabretta
d23 1
a23 1
* $Id: tspc.f,v 7.6.1.2 2021/07/02 06:41:29 mcalabre Exp mcalabre $
@


7.7.1.1
log
@WCSLIB 7.7 development branch.
@
text
@d23 1
a23 1
* $Id: tspc.f,v 7.7 2021/07/12 06:36:49 mcalabre Exp $
@


7.7.1.2
log
@Updated date in copyright notice.
@
text
@d4 1
a4 1
* Copyright (C) 1995-2022, Mark Calabretta
d23 1
a23 1
* $Id: tspc.f,v 7.7.1.1 2021/07/12 06:38:28 mcalabre Exp mcalabre $
@


7.6
log
@WCSLIB 7.6
@
text
@d3 1
a3 1
* WCSLIB 7.6 - an implementation of the FITS WCS standard.
d23 1
a23 1
* $Id: tspc.f,v 7.5.1.1 2021/03/20 05:56:42 mcalabre Exp mcalabre $
d34 1
a34 1
      PARAMETER (NSPEC = 10001)
d245 1
a245 1
      PARAMETER (NSPEC = 10001)
@


7.6.1.1
log
@WCSLIB 7.6 development branch.
@
text
@d23 1
a23 1
* $Id: tspc.f,v 7.6 2021/04/13 12:57:02 mcalabre Exp $
@


7.6.1.2
log
@In FUNCTION CLOSURE, gfortran 11.1.0 complained about the size of three DOUBLE
PRECISION arrays - CLOS, SPEC1, and SPEC2 - dimensioned by NSPEC ("larger than
limit set by ‘-fmax-stack-var-size=’, moved from stack to static storage...").
Reduced NSPEC from 10001, which seemed unnecessarily large, to 8001.
@
text
@d23 1
a23 1
* $Id: tspc.f,v 7.6.1.1 2021/04/13 13:00:36 mcalabre Exp mcalabre $
d34 1
a34 1
      PARAMETER (NSPEC = 8001)
d245 1
a245 1
      PARAMETER (NSPEC = 8001)
@


7.5
log
@WCSLIB 7.5
@
text
@d3 1
a3 1
* WCSLIB 7.5 - an implementation of the FITS WCS standard.
d23 1
a23 1
* $Id: tspc.f,v 7.4.1.1 2021/01/31 02:26:24 mcalabre Exp mcalabre $
@


7.5.1.1
log
@WCSLIB 7.5 development branch.
@
text
@d23 1
a23 1
* $Id: tspc.f,v 7.5 2021/03/20 05:54:58 mcalabre Exp $
@


7.4
log
@WCSLIB 7.4
@
text
@d3 1
a3 1
* WCSLIB 7.4 - an implementation of the FITS WCS standard.
d23 1
a23 1
* $Id: tspc.f,v 7.3.1.3 2021/01/28 12:32:09 mcalabre Exp mcalabre $
@


7.4.1.1
log
@WCSLIB 7.4 development branch.
@
text
@d23 1
a23 1
* $Id: tspc.f,v 7.4 2021/01/31 02:24:52 mcalabre Exp $
@


7.3
log
@WCSLIB 7.3
@
text
@d3 2
a4 2
* WCSLIB 7.3 - an implementation of the FITS WCS standard.
* Copyright (C) 1995-2020, Mark Calabretta
a20 2
* Direct correspondence concerning WCSLIB to mark@@calabretta.id.au
*
d23 1
a23 1
* $Id: tspc.f,v 7.2.1.2 2020/05/07 03:47:32 mcalabre Exp mcalabre $
@


7.3.1.1
log
@WCSLIB 7.3 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 7.3 2020/06/03 03:37:03 mcalabre Exp $
@


7.3.1.2
log
@Updated date in copyright notice.
@
text
@d4 1
a4 1
* Copyright (C) 1995-2021, Mark Calabretta
d25 1
a25 1
* $Id: tspc.f,v 7.3.1.1 2020/06/03 03:38:11 mcalabre Exp mcalabre $
@


7.3.1.3
log
@Removed my email address from the copyright notice.
@
text
@d21 2
d25 1
a25 1
* $Id: tspc.f,v 7.3.1.2 2021/01/19 14:11:08 mcalabre Exp mcalabre $
@


7.2
log
@WCSLIB 7.2
@
text
@d3 1
a3 1
* WCSLIB 7.2 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 7.1.1.1 2019/12/31 13:28:19 mcalabre Exp mcalabre $
d287 7
a293 7
        STATUS = SPCPUT (SPC, SPC_PV, MARS(0), 0)
        STATUS = SPCPUT (SPC, SPC_PV, MARS(1), 1)
        STATUS = SPCPUT (SPC, SPC_PV, MARS(2), 2)
        STATUS = SPCPUT (SPC, SPC_PV, MARS(3), 3)
        STATUS = SPCPUT (SPC, SPC_PV, MARS(4), 4)
        STATUS = SPCPUT (SPC, SPC_PV, MARS(5), 5)
        STATUS = SPCPUT (SPC, SPC_PV, MARS(6), 6)
d308 6
a313 6
      STATUS = SPCPUT (SPC, SPC_FLAG, 0, 0)
      STATUS = SPCPUT (SPC, SPC_CRVAL, CRVALS, 0)
      STATUS = SPCPUT (SPC, SPC_RESTFRQ, RESTFRQ, 0)
      STATUS = SPCPUT (SPC, SPC_RESTWAV, RESTWAV, 0)
      STATUS = SPCPUT (SPC, SPC_TYPE, CTYPES, 0)
      STATUS = SPCPUT (SPC, SPC_CODE, CTYPES(6:8), 0)
d335 1
a335 1
      STATUS = SPCGET (SPC, SPC_TYPE, STYPE, 0)
@


7.2.1.1
log
@WCSLIB 7.2 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 7.2 2020/03/09 07:31:24 mcalabre Exp $
@


7.2.1.2
log
@Replaced calls to SPCPUT and SPCGET with their type-specific equivalents.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 7.2.1.1 2020/03/09 07:34:50 mcalabre Exp mcalabre $
d287 7
a293 7
        STATUS = SPCPTD (SPC, SPC_PV, MARS(0), 0)
        STATUS = SPCPTD (SPC, SPC_PV, MARS(1), 1)
        STATUS = SPCPTD (SPC, SPC_PV, MARS(2), 2)
        STATUS = SPCPTD (SPC, SPC_PV, MARS(3), 3)
        STATUS = SPCPTD (SPC, SPC_PV, MARS(4), 4)
        STATUS = SPCPTD (SPC, SPC_PV, MARS(5), 5)
        STATUS = SPCPTD (SPC, SPC_PV, MARS(6), 6)
d308 6
a313 6
      STATUS = SPCPTI (SPC, SPC_FLAG, 0, 0)
      STATUS = SPCPTD (SPC, SPC_CRVAL, CRVALS, 0)
      STATUS = SPCPTD (SPC, SPC_RESTFRQ, RESTFRQ, 0)
      STATUS = SPCPTD (SPC, SPC_RESTWAV, RESTWAV, 0)
      STATUS = SPCPTC (SPC, SPC_TYPE, CTYPES, 0)
      STATUS = SPCPTC (SPC, SPC_CODE, CTYPES(6:8), 0)
d335 1
a335 1
      STATUS = SPCGTC (SPC, SPC_TYPE, STYPE, 0)
@


7.1
log
@WCSLIB 7.1
@
text
@d3 1
a3 1
* WCSLIB 7.1 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 6.4.1.3 2019/12/31 03:29:14 mcalabre Exp mcalabre $
@


7.1.1.1
log
@WCSLIB 7.1 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 7.1 2019/12/31 13:25:19 mcalabre Exp $
@


6.4
log
@WCSLIB 6.4
@
text
@d3 2
a4 2
* WCSLIB 6.4 - an implementation of the FITS WCS standard.
* Copyright (C) 1995-2019, Mark Calabretta
d25 1
a25 1
* $Id: tspc.f,v 6.3.1.1 2019/07/12 07:34:37 mcalabre Exp mcalabre $
d255 1
a255 1
      CHARACTER CTYPES*8, PTYPE, SCODE*3, SNAME*21, STYPE*4, TITLE*80,
d339 1
a339 1
 60       FORMAT (A,': w =',1PE20.12,' -> ',A,' = ???, stat = ',I2)
d345 1
a345 1
 70       FORMAT (A,': w =',1PE20.12,' -> ',A,' =',1PE20.12,
d357 1
a357 1
 80       FORMAT (A,': w =',1PE20.12,' -> ',A,' =',1PE20.12,' ->',/,
@


6.4.1.1
log
@WCSLIB 6.4 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 6.4 2019/08/15 09:30:18 mcalabre Exp $
@


6.4.1.2
log
@In CLOSURE, a CHARACTER variable of length 8 (STYPE) is required for
SPC_TYPE from SPCGET.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 6.4.1.1 2019/08/15 09:31:29 mcalabre Exp mcalabre $
d255 1
a255 1
      CHARACTER CTYPES*8, PTYPE, SCODE*3, SNAME*21, STYPE*8, TITLE*80,
d339 1
a339 1
 60       FORMAT (A,': w =',1PE20.12,' -> ',A4,' = ???, stat = ',I2)
d345 1
a345 1
 70       FORMAT (A,': w =',1PE20.12,' -> ',A4,' =',1PE20.12,
d357 1
a357 1
 80       FORMAT (A,': w =',1PE20.12,' -> ',A4,' =',1PE20.12,' ->',/,
@


6.4.1.3
log
@Updated date in copyright notice.
@
text
@d4 1
a4 1
* Copyright (C) 1995-2020, Mark Calabretta
d25 1
a25 1
* $Id: tspc.f,v 6.4.1.2 2019/12/31 02:52:22 mcalabre Exp mcalabre $
@


6.3
log
@WCSLIB 6.3
@
text
@d3 1
a3 1
* WCSLIB 6.3 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 6.2.1.3 2019/07/07 13:39:29 mcalabre Exp mcalabre $
@


6.3.1.1
log
@WCSLIB 6.3 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 6.3 2019/07/12 07:33:40 mcalabre Exp $
@


6.2
log
@WCSLIB 6.2
@
text
@d3 2
a4 2
* WCSLIB 6.2 - an implementation of the FITS WCS standard.
* Copyright (C) 1995-2018, Mark Calabretta
d25 1
a25 1
* $Id: tspc.f,v 6.1.1.1 2018/10/19 08:36:15 mcalabre Exp mcalabre $
d271 2
a278 1
        CLOSURE = 0
@


6.2.1.1
log
@WCSLIB 6.2 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 6.2 2018/10/20 10:03:14 mcalabre Exp $
@


6.2.1.2
log
@Updated date in copyright notice.
@
text
@d4 1
a4 1
* Copyright (C) 1995-2019, Mark Calabretta
d25 1
a25 1
* $Id: tspc.f,v 6.2.1.1 2018/10/20 10:04:15 mcalabre Exp mcalabre $
@


6.2.1.3
log
@Ensure that function CLOSURE always returns a value.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 6.2.1.2 2019/05/10 02:08:35 mcalabre Exp mcalabre $
a270 2
      CLOSURE = 0

d277 1
@


6.1
log
@WCSLIB 6.1
@
text
@d3 1
a3 1
* WCSLIB 6.1 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 5.20.1.2 2018/10/19 05:18:12 mcalabre Exp mcalabre $
@


6.1.1.1
log
@WCSLIB 6.1 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 6.1 2018/10/19 08:35:17 mcalabre Exp $
@


5.20
log
@WCSLIB 5.20
@
text
@d3 1
a3 1
* WCSLIB 5.20 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 5.19.1.1 2018/07/26 15:41:42 mcalabre Exp mcalabre $
d275 3
a277 2
        WRITE (*, 5) STATUS, CTYPES
 5      FORMAT ('ERROR',I2,' from SPCXPS for',A,'.')
d296 1
a296 1
      DO 10 J = 1, NAXISJ
d298 1
a298 1
 10   CONTINUE
d300 1
a300 1
      WRITE (*, 20) CTYPES, CRVALS+SPEC1(1), CRVALS+SPEC1(NAXISJ),
d302 1
a302 1
 20   FORMAT (A,' (CRVALk+w) range: ',1PE13.6,' to ',1PE13.6,', step: ',
d317 2
a318 2
        WRITE (*, 30) STATUS
 30     FORMAT ('SPCX2S ERROR',I2,'.')
d325 2
a326 2
        WRITE (*, 40) STATUS
 40     FORMAT ('SPCS2X ERROR',I2,'.')
d335 1
a335 1
      DO 80 J = 1, NAXISJ
d337 3
a339 3
          WRITE (*, 50) CTYPES, SPEC1(J), STYPE, STAT1(J)
 50       FORMAT (A,': w =',1PE20.12,' -> ',A,' = ???, stat = ',I2)
          GO TO 80
d343 2
a344 2
          WRITE (*, 60) CTYPES, SPEC1(J), STYPE, SPEC2(J), STAT2(J)
 60       FORMAT (A,': w =',1PE20.12,' -> ',A,' =',1PE20.12,
d346 1
a346 1
          GO TO 80
d354 1
a354 1
          WRITE (*, 70) CTYPES, SPEC1(J), STYPE, SPEC2(J), CLOS(J),
d356 1
a356 1
 70       FORMAT (A,': w =',1PE20.12,' -> ',A,' =',1PE20.12,' ->',/,
d359 1
a359 1
 80   CONTINUE
d361 2
a362 2
      WRITE (*, 90) CTYPES, RESIDMAX
 90   FORMAT (A,': Maximum closure residual =',1PE8.1,' pixel')
d373 1
a373 1
      DO 100 J = 1, NAXISJ
d378 1
a378 1
 100  CONTINUE
d395 4
a398 4
      DO 110 J = 21, 1, -1
        IF (SNAME(J:J).NE.' ') GO TO 120
 110  CONTINUE
 120  YLAB  = SNAME(:J) // ' - correction ' // UNITS
d416 2
a417 2
      READ (*, *, END=130)
 130  WRITE (*, *)
@


5.20.1.1
log
@WCSLIB 5.20 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 5.20 2018/10/05 05:32:42 mcalabre Exp $
@


5.20.1.2
log
@Fixed a compiler warning - function CLOSURE must always return a value.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 5.20.1.1 2018/10/05 05:33:33 mcalabre Exp mcalabre $
d275 2
a276 3
        WRITE (*, 10) STATUS, CTYPES
 10     FORMAT ('ERROR',I2,' from SPCXPS for',A,'.')
        CLOSURE = 0
d295 1
a295 1
      DO 20 J = 1, NAXISJ
d297 1
a297 1
 20   CONTINUE
d299 1
a299 1
      WRITE (*, 30) CTYPES, CRVALS+SPEC1(1), CRVALS+SPEC1(NAXISJ),
d301 1
a301 1
 30   FORMAT (A,' (CRVALk+w) range: ',1PE13.6,' to ',1PE13.6,', step: ',
d316 2
a317 2
        WRITE (*, 40) STATUS
 40     FORMAT ('SPCX2S ERROR',I2,'.')
d324 2
a325 2
        WRITE (*, 50) STATUS
 50     FORMAT ('SPCS2X ERROR',I2,'.')
d334 1
a334 1
      DO 90 J = 1, NAXISJ
d336 3
a338 3
          WRITE (*, 60) CTYPES, SPEC1(J), STYPE, STAT1(J)
 60       FORMAT (A,': w =',1PE20.12,' -> ',A,' = ???, stat = ',I2)
          GO TO 90
d342 2
a343 2
          WRITE (*, 70) CTYPES, SPEC1(J), STYPE, SPEC2(J), STAT2(J)
 70       FORMAT (A,': w =',1PE20.12,' -> ',A,' =',1PE20.12,
d345 1
a345 1
          GO TO 90
d353 1
a353 1
          WRITE (*, 80) CTYPES, SPEC1(J), STYPE, SPEC2(J), CLOS(J),
d355 1
a355 1
 80       FORMAT (A,': w =',1PE20.12,' -> ',A,' =',1PE20.12,' ->',/,
d358 1
a358 1
 90   CONTINUE
d360 2
a361 2
      WRITE (*, 100) CTYPES, RESIDMAX
 100  FORMAT (A,': Maximum closure residual =',1PE8.1,' pixel')
d372 1
a372 1
      DO 110 J = 1, NAXISJ
d377 1
a377 1
 110  CONTINUE
d394 4
a397 4
      DO 120 J = 21, 1, -1
        IF (SNAME(J:J).NE.' ') GO TO 130
 120  CONTINUE
 130  YLAB  = SNAME(:J) // ' - correction ' // UNITS
d415 2
a416 2
      READ (*, *, END=140)
 140  WRITE (*, *)
@


5.19
log
@WCSLIB 5.19
@
text
@d3 1
a3 1
* WCSLIB 5.19 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 5.18.1.1 2018/01/10 08:33:04 mcalabre Exp mcalabre $
@


5.19.1.1
log
@WCSLIB 5.19 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 5.19 2018/07/26 15:37:05 mcalabre Exp $
@


5.18
log
@WCSLIB 5.18
@
text
@d3 1
a3 1
* WCSLIB 5.18 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 5.17.1.2 2018/01/10 08:26:53 mcalabre Exp mcalabre $
@


5.18.1.1
log
@WCSLIB 5.18 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 5.18 2018/01/10 08:32:14 mcalabre Exp $
@


5.17
log
@WCSLIB 5.17
@
text
@d3 2
a4 2
* WCSLIB 5.17 - an implementation of the FITS WCS standard.
* Copyright (C) 1995-2017, Mark Calabretta
d25 1
a25 1
* $Id: tspc.f,v 5.16.1.1 2017/01/15 04:29:03 mcalabre Exp mcalabre $
@


5.17.1.1
log
@WCSLIB 5.17 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 5.17 2017/09/18 08:44:24 mcalabre Exp $
@


5.17.1.2
log
@Updated date in copyright notice.
@
text
@d4 1
a4 1
* Copyright (C) 1995-2018, Mark Calabretta
d25 1
a25 1
* $Id: tspc.f,v 5.17.1.1 2017/09/18 08:46:00 mcalabre Exp mcalabre $
@


5.16
log
@WCSLIB 5.16
@
text
@d3 1
a3 1
* WCSLIB 5.16 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 5.15.1.2 2017/01/15 04:08:23 mcalabre Exp mcalabre $
@


5.16.1.1
log
@WCSLIB 5.16 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 5.16 2017/01/15 04:25:03 mcalabre Exp $
@


5.15
log
@WCSLIB 5.15
@
text
@d3 2
a4 2
* WCSLIB 5.15 - an implementation of the FITS WCS standard.
* Copyright (C) 1995-2016, Mark Calabretta
d25 1
a25 1
* $Id: tspc.f,v 5.14.1.1 2016/02/07 10:52:48 mcalabre Exp mcalabre $
@


5.15.1.1
log
@WCSLIB 5.15 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 5.15 2016/04/05 12:55:12 mcalabre Exp $
@


5.15.1.2
log
@Updated date in copyright notice.
@
text
@d4 1
a4 1
* Copyright (C) 1995-2017, Mark Calabretta
d25 1
a25 1
* $Id: tspc.f,v 5.15.1.1 2016/04/05 12:58:38 mcalabre Exp mcalabre $
@


5.14
log
@WCSLIB 5.14
@
text
@d3 1
a3 1
* WCSLIB 5.14 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 5.13.1.1 2016/01/26 08:54:35 mcalabre Exp mcalabre $
@


5.14.1.1
log
@WCSLIB 5.14 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 5.14 2016/02/07 10:49:32 mcalabre Exp $
@


5.13
log
@WCSLIB 5.13
@
text
@d3 1
a3 1
* WCSLIB 5.13 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 5.12.1.2 2016/01/25 05:21:36 mcalabre Exp mcalabre $
@


5.13.1.1
log
@WCSLIB 5.13 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 5.13 2016/01/26 08:51:16 mcalabre Exp $
@


5.12
log
@WCSLIB 5.12
@
text
@d3 2
a4 2
* WCSLIB 5.12 - an implementation of the FITS WCS standard.
* Copyright (C) 1995-2015, Mark Calabretta
d25 1
a25 1
* $Id: tspc.f,v 5.11.1.1 2015/10/18 09:16:30 mcalabre Exp mcalabre $
@


5.12.1.1
log
@WCSLIB 5.12 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 5.12 2015/11/15 02:13:02 mcalabre Exp $
@


5.12.1.2
log
@Updated date in copyright notice.
@
text
@d4 1
a4 1
* Copyright (C) 1995-2016, Mark Calabretta
d25 1
a25 1
* $Id: tspc.f,v 5.12.1.1 2015/11/15 02:16:17 mcalabre Exp mcalabre $
@


5.11
log
@WCSLIB 5.11
@
text
@d3 1
a3 1
* WCSLIB 5.11 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 5.10.1.1 2015/10/09 08:22:39 mcalabre Exp mcalabre $
@


5.11.1.1
log
@WCSLIB 5.11 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 5.11 2015/10/18 09:13:07 mcalabre Exp $
@


5.10
log
@WCSLIB 5.10
@
text
@d3 1
a3 1
* WCSLIB 5.10 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 5.9.1.1 2015/07/21 09:28:11 mcalabre Exp mcalabre $
@


5.10.1.1
log
@WCSLIB 5.10 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 5.10 2015/10/09 08:19:17 mcalabre Exp $
@


5.9
log
@WCSLIB 5.9
@
text
@d3 1
a3 1
* WCSLIB 5.9 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 5.8.1.1 2015/07/08 11:07:22 mcalabre Exp mcalabre $
@


5.9.1.1
log
@WCSLIB 5.9 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 5.9 2015/07/21 09:20:04 mcalabre Exp $
@


5.8
log
@WCSLIB 5.8
@
text
@d3 1
a3 1
* WCSLIB 5.8 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 5.7.1.1 2015/06/29 02:47:26 mcalabre Exp mcalabre $
@


5.8.1.1
log
@WCSLIB 5.8 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 5.8 2015/07/08 11:04:02 mcalabre Exp $
@


5.7
log
@WCSLIB 5.7
@
text
@d3 1
a3 1
* WCSLIB 5.7 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 5.6.1.1 2015/06/14 07:14:47 mcalabre Exp mcalabre $
@


5.7.1.1
log
@WCSLIB 5.7 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 5.7 2015/06/29 02:44:18 mcalabre Exp $
@


5.6
log
@WCSLIB 5.6
@
text
@d3 1
a3 1
* WCSLIB 5.6 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 5.5.1.1 2015/05/05 13:21:03 mcalabre Exp mcalabre $
@


5.6.1.1
log
@WCSLIB 5.6 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 5.6 2015/06/14 07:11:26 mcalabre Exp $
@


5.5
log
@WCSLIB 5.5
@
text
@d3 1
a3 1
* WCSLIB 5.5 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 5.4.1.1 2015/04/21 14:44:31 mcalabre Exp mcalabre $
@


5.5.1.1
log
@WCSLIB 5.5 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 5.5 2015/05/05 13:16:33 mcalabre Exp $
@


5.4
log
@WCSLIB 5.4
@
text
@d3 1
a3 1
* WCSLIB 5.4 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 5.3.1.1 2015/04/21 02:54:05 mcalabre Exp mcalabre $
@


5.4.1.1
log
@WCSLIB 5.4 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 5.4 2015/04/21 14:41:07 mcalabre Exp $
@


5.3
log
@WCSLIB 5.3
@
text
@d3 1
a3 1
* WCSLIB 5.3 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 5.2.1.1 2015/04/15 12:39:18 mcalabre Exp mcalabre $
@


5.3.1.1
log
@WCSLIB 5.3 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 5.3 2015/04/21 02:50:53 mcalabre Exp $
@


5.2
log
@WCSLIB 5.2
@
text
@d3 1
a3 1
* WCSLIB 5.2 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 5.1.1.1 2015/04/07 11:01:12 mcalabre Exp mcalabre $
@


5.2.1.1
log
@WCSLIB 5.2 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 5.2 2015/04/15 12:35:09 mcalabre Exp $
@


5.1
log
@WCSLIB 5.1
@
text
@d3 1
a3 1
* WCSLIB 5.1 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 5.0.1.1 2015/04/05 12:28:03 mcalabre Exp mcalabre $
@


5.1.1.1
log
@WCSLIB 5.1 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 5.1 2015/04/07 10:56:38 mcalabre Exp $
@


5.0
log
@WCSLIB 5.0
@
text
@d3 1
a3 1
* WCSLIB 5.0 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 4.25.1.2 2015/01/06 01:02:37 mcalabre Exp mcalabre $
@


5.0.1.1
log
@WCSLIB 5.0 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 5.0 2015/04/05 12:25:02 mcalabre Exp $
@


4.25
log
@WCSLIB 4.25
@
text
@d3 2
a4 2
* WCSLIB 4.25 - an implementation of the FITS WCS standard.
* Copyright (C) 1995-2014, Mark Calabretta
d25 1
a25 1
* $Id: tspc.f,v 4.24.1.1 2014/09/18 15:28:12 mcalabre Exp mcalabre $
@


4.25.1.1
log
@WCSLIB 4.25 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 4.25 2014/12/14 14:29:38 mcalabre Exp $
@


4.25.1.2
log
@Updated date in copyright notice.
@
text
@d4 1
a4 1
* Copyright (C) 1995-2015, Mark Calabretta
d25 1
a25 1
* $Id: tspc.f,v 4.25.1.1 2014/12/14 14:32:47 mcalabre Exp mcalabre $
@


4.24
log
@WCSLIB 4.24
@
text
@d3 1
a3 1
* WCSLIB 4.24 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 4.23.1.1 2014/05/13 05:53:51 mcalabre Exp mcalabre $
@


4.24.1.1
log
@WCSLIB 4.24 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 4.24 2014/09/18 15:25:02 mcalabre Exp $
@


4.23
log
@WCSLIB 4.23
@
text
@d3 1
a3 1
* WCSLIB 4.23 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 4.22.1.1 2014/04/12 15:06:34 mcalabre Exp mcalabre $
@


4.23.1.1
log
@WCSLIB 4.23 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 4.23 2014/05/13 05:50:53 mcalabre Exp $
@


4.22
log
@WCSLIB 4.22
@
text
@d3 1
a3 1
* WCSLIB 4.22 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 4.21.1.1 2014/03/24 05:15:30 mcalabre Exp mcalabre $
@


4.22.1.1
log
@WCSLIB 4.22 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 4.22 2014/04/12 15:03:53 mcalabre Exp $
@


4.21
log
@WCSLIB 4.21
@
text
@d3 1
a3 1
* WCSLIB 4.21 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 4.20.1.2 2014/03/21 06:41:05 mcalabre Exp mcalabre $
@


4.21.1.1
log
@WCSLIB 4.21 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 4.21 2014/03/24 05:12:29 mcalabre Exp $
@


4.20
log
@WCSLIB 4.20
@
text
@d3 2
a4 2
* WCSLIB 4.20 - an implementation of the FITS WCS standard.
* Copyright (C) 1995-2013, Mark Calabretta
d25 1
a25 1
* $Id: tspc.f,v 4.19.1.1 2013/09/29 14:20:40 mcalabre Exp mcalabre $
@


4.20.1.1
log
@WCSLIB 4.20 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 4.20 2013/12/18 05:42:50 mcalabre Exp $
@


4.20.1.2
log
@Updated date in copyright notice.
@
text
@d4 1
a4 1
* Copyright (C) 1995-2014, Mark Calabretta
d25 1
a25 1
* $Id: tspc.f,v 4.20.1.1 2013/12/18 05:46:56 mcalabre Exp mcalabre $
@


4.19
log
@WCSLIB 4.19
@
text
@d3 1
a3 1
* WCSLIB 4.19 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 4.18.1.1 2013/07/13 10:02:39 mcalabre Exp mcalabre $
@


4.19.1.1
log
@WCSLIB 4.19 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 4.19 2013/09/29 14:17:53 mcalabre Exp $
@


4.18
log
@WCSLIB 4.18
@
text
@d3 1
a3 1
* WCSLIB 4.18 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 4.17.1.1 2013/01/29 05:32:33 cal103 Exp cal103 $
@


4.18.1.1
log
@WCSLIB 4.18 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 4.18 2013/07/13 10:00:06 mcalabre Exp $
@


4.17
log
@WCSLIB 4.17
@
text
@d3 1
a3 1
* WCSLIB 4.17 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 4.16.1.2 2013/01/29 05:11:18 cal103 Exp cal103 $
@


4.17.1.1
log
@WCSLIB 4.17 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 4.17 2013/01/29 05:29:22 cal103 Exp $
@


4.16
log
@WCSLIB 4.16
@
text
@d3 2
a4 2
* WCSLIB 4.16 - an implementation of the FITS WCS standard.
* Copyright (C) 1995-2012, Mark Calabretta
d25 1
a25 1
* $Id: tspc.f,v 4.15.1.1 2012/09/26 14:27:52 cal103 Exp cal103 $
@


4.16.1.1
log
@WCSLIB 4.16 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 4.16 2012/11/07 04:42:45 cal103 Exp $
@


4.16.1.2
log
@Updated date in copyright notice.
@
text
@d4 1
a4 1
* Copyright (C) 1995-2013, Mark Calabretta
d25 1
a25 1
* $Id: tspc.f,v 4.16.1.1 2012/11/07 04:45:57 cal103 Exp cal103 $
@


4.15
log
@WCSLIB 4.15
@
text
@d3 1
a3 1
* WCSLIB 4.15 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 4.14.1.1 2012/07/13 10:04:58 cal103 Exp cal103 $
@


4.15.1.1
log
@WCSLIB 4.15 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 4.15 2012/09/26 14:26:06 cal103 Exp $
@


4.14
log
@WCSLIB 4.14
@
text
@d3 1
a3 1
* WCSLIB 4.14 - an implementation of the FITS WCS standard.
d25 1
a25 1
* $Id: tspc.f,v 4.13.1.2 2012/07/13 03:41:54 cal103 Exp cal103 $
@


4.14.1.1
log
@WCSLIB 4.14 development branch.
@
text
@d25 1
a25 1
* $Id: tspc.f,v 4.14 2012/07/13 10:02:42 cal103 Exp $
@


4.13
log
@WCSLIB 4.13
@
text
@d3 1
a3 1
* WCSLIB 4.13 - an implementation of the FITS WCS standard.
d21 1
a21 7
* 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
d23 3
a25 3
* Author: Mark Calabretta, Australia Telescope National Facility
* http://www.atnf.csiro.au/~mcalabre/index.html
* $Id: tspc.f,v 4.12.1.1 2012/02/29 07:59:11 cal103 Exp cal103 $
@


4.13.1.1
log
@WCSLIB 4.13 development branch.
@
text
@d31 1
a31 1
* $Id: tspc.f,v 4.13 2012/03/14 07:39:31 cal103 Exp $
@


4.13.1.2
log
@Changed contact details.
@
text
@d21 7
a27 1
* Direct correspondence concerning WCSLIB to mark@@calabretta.id.au
d29 3
a31 3
* Author: Mark Calabretta, Australia Telescope National Facility, CSIRO.
* http://www.atnf.csiro.au/people/Mark.Calabretta
* $Id: tspc.f,v 4.13.1.1 2012/03/14 07:40:38 cal103 Exp cal103 $
@


4.12
log
@WCSLIB 4.12
@
text
@d3 1
a3 1
* WCSLIB 4.12 - an implementation of the FITS WCS standard.
d31 1
a31 1
* $Id: tspc.f,v 4.11.1.1 2012/02/20 23:31:14 cal103 Exp cal103 $
@


4.12.1.1
log
@WCSLIB 4.12 development branch.
@
text
@d31 1
a31 1
* $Id: tspc.f,v 4.12 2012/02/29 07:57:57 cal103 Exp $
@


4.11
log
@WCSLIB 4.11
@
text
@d3 1
a3 1
* WCSLIB 4.11 - an implementation of the FITS WCS standard.
d31 1
a31 1
* $Id: tspc.f,v 4.10.1.1 2012/02/05 23:42:47 cal103 Exp cal103 $
@


4.11.1.1
log
@WCSLIB 4.11 development branch.
@
text
@d31 1
a31 1
* $Id: tspc.f,v 4.11 2012/02/20 23:30:03 cal103 Exp $
@


4.10
log
@WCSLIB 4.10
@
text
@d3 1
a3 1
* WCSLIB 4.10 - an implementation of the FITS WCS standard.
d31 1
a31 1
* $Id: tspc.f,v 4.9.1.1 2012/01/24 05:41:46 cal103 Exp cal103 $
@


4.10.1.1
log
@WCSLIB 4.10 development branch.
@
text
@d31 1
a31 1
* $Id: tspc.f,v 4.10 2012/02/05 23:41:44 cal103 Exp $
@


4.9
log
@WCSLIB 4.9
@
text
@d3 1
a3 1
* WCSLIB 4.9 - an implementation of the FITS WCS standard.
d31 1
a31 1
* $Id: tspc.f,v 4.8.1.3 2012/01/24 05:24:12 cal103 Exp cal103 $
@


4.9.1.1
log
@WCSLIB 4.9 development branch.
@
text
@d31 1
a31 1
* $Id: tspc.f,v 4.9 2012/01/24 05:40:30 cal103 Exp $
@


4.8
log
@WCSLIB 4.8
@
text
@d3 2
a4 2
* WCSLIB 4.8 - an implementation of the FITS WCS standard.
* Copyright (C) 1995-2011, Mark Calabretta
d31 1
a31 1
* $Id: tspc.f,v 4.7.1.2 2011/08/12 14:31:25 cal103 Exp cal103 $
d264 3
@


4.8.1.1
log
@WCSLIB 4.8 development branch.
@
text
@d31 1
a31 1
* $Id: tspc.f,v 4.8 2011/08/15 08:05:54 cal103 Exp $
@


4.8.1.2
log
@Added a comment in the code reinforcing the necessity for INTEGER arrays
holding structs to be aligned on a DOUBLE PRECISION boundary.
@
text
@d31 1
a31 1
* $Id: tspc.f,v 4.8.1.1 2011/08/15 08:07:07 cal103 Exp cal103 $
a263 3
*     On some systems, such as Sun Sparc, the struct MUST be aligned
*     on a double precision boundary, done here using an equivalence.
*     Failure to do this may result in mysterious "bus errors".
@


4.8.1.3
log
@Updated date in copyright notice.
@
text
@d4 1
a4 1
* Copyright (C) 1995-2012, Mark Calabretta
d31 1
a31 1
* $Id: tspc.f,v 4.8.1.2 2011/08/16 01:34:41 cal103 Exp cal103 $
@


4.7
log
@WCSLIB 4.7
@
text
@d3 1
a3 1
* WCSLIB 4.7 - an implementation of the FITS WCS standard.
d31 1
a31 1
* $Id: tspc.f,v 4.6.1.3 2011/01/27 01:21:42 cal103 Exp cal103 $
d44 1
a44 1
      INTEGER   NAXISJ
d61 1
a61 1

d79 12
a90 12
      CALL CLOSURE('WAVE-F2W',     0D0,     0D0, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('VOPT-F2W',     0D0, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('ZOPT-F2W',     0D0, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('AWAV-F2A',     0D0,     0D0, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('VELO-F2V', RESTFRQ,     0D0, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('BETA-F2V', RESTFRQ,     0D0, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
d103 16
a118 16
      CALL CLOSURE('FREQ-W2F',     0D0,     0D0, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('AFRQ-W2F',     0D0,     0D0, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('ENER-W2F',     0D0,     0D0, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('WAVN-W2F',     0D0,     0D0, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('VRAD-W2F', RESTFRQ,     0D0, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('AWAV-W2A',     0D0,     0D0, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('VELO-W2V',     0D0, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('BETA-W2V',     0D0, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
d125 20
a144 20
      CALL CLOSURE('FREQ-A2F',     0D0,     0D0, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('AFRQ-A2F',     0D0,     0D0, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('ENER-A2F',     0D0,     0D0, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('WAVN-A2F',     0D0,     0D0, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('VRAD-A2F', RESTFRQ,     0D0, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('WAVE-A2W',     0D0,     0D0, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('VOPT-A2W',     0D0, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('ZOPT-A2W',     0D0, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('VELO-A2V',     0D0, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('BETA-A2V',     0D0, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
d157 18
a174 18
      CALL CLOSURE('FREQ-V2F', RESTFRQ,     0D0, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('AFRQ-V2F', RESTFRQ,     0D0, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('ENER-V2F', RESTFRQ,     0D0, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('WAVN-V2F', RESTFRQ,     0D0, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('VRAD-V2F', RESTFRQ,     0D0, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('WAVE-V2W',     0D0, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('VOPT-V2W',     0D0, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('ZOPT-V2W',     0D0, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('AWAV-V2A',     0D0, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
d187 22
a208 22
      CALL CLOSURE('FREQ-GRI',     0D0,     0D0, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('AFRQ-GRI',     0D0,     0D0, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('ENER-GRI',     0D0,     0D0, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('WAVN-GRI',     0D0,     0D0, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('VRAD-GRI', RESTFRQ,     0D0, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('WAVE-GRI',     0D0,     0D0, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('VOPT-GRI',     0D0, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('ZOPT-GRI',     0D0, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('AWAV-GRI',     0D0,     0D0, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('VELO-GRI',     0D0, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('BETA-GRI',     0D0, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
d226 4
a229 4
      CALL CLOSURE('AWAV-GRA',     0D0,     0D0, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
      CALL CLOSURE('VELO-GRA',     0D0, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
     :             CRVALX)
d234 11
d249 2
a250 2
      SUBROUTINE CLOSURE (CTYPES, RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :   CDELTX, CRVALX)
d255 2
a256 1
      INTEGER   J, NAXISJ, RESTREQ, STAT1(NSPEC), STAT2(NSPEC), STATUS
a331 1
      RESIDMAX = 0D0
d334 2
d355 1
d359 1
a359 1
     :           '          w =',1PE20.12,',  resid =',1PE20.12)
d364 1
a364 1
 90   FORMAT (A,': Maximum closure residual =',1PE19.12,' pixel')
d421 2
a422 1
      RETURN
@


4.7.1.1
log
@WCSLIB 4.7 development branch.
@
text
@d31 1
a31 1
* $Id: tspc.f,v 4.7 2011/02/07 07:03:43 cal103 Exp $
@


4.7.1.2
log
@Report PASS or FAIL and the number of failures.
@
text
@d31 1
a31 1
* $Id: tspc.f,v 4.7.1.1 2011/02/07 07:04:23 cal103 Exp cal103 $
d44 1
a44 1
      INTEGER   CLOSURE, NAXISJ, NFAIL
d61 1
a61 1
      NFAIL = 0
d79 12
a90 12
      NFAIL = NFAIL + CLOSURE('WAVE-F2W', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('VOPT-F2W', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('ZOPT-F2W', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('AWAV-F2A', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('VELO-F2V', RESTFRQ, 0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('BETA-F2V', RESTFRQ, 0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
d103 16
a118 16
      NFAIL = NFAIL + CLOSURE('FREQ-W2F', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('AFRQ-W2F', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('ENER-W2F', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('WAVN-W2F', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('VRAD-W2F', RESTFRQ, 0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('AWAV-W2A', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('VELO-W2V', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('BETA-W2V', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
d125 20
a144 20
      NFAIL = NFAIL + CLOSURE('FREQ-A2F', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('AFRQ-A2F', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('ENER-A2F', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('WAVN-A2F', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('VRAD-A2F', RESTFRQ, 0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('WAVE-A2W', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('VOPT-A2W', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('ZOPT-A2W', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('VELO-A2V', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('BETA-A2V', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
d157 18
a174 18
      NFAIL = NFAIL + CLOSURE('FREQ-V2F', RESTFRQ, 0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('AFRQ-V2F', RESTFRQ, 0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('ENER-V2F', RESTFRQ, 0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('WAVN-V2F', RESTFRQ, 0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('VRAD-V2F', RESTFRQ, 0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('WAVE-V2W', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('VOPT-V2W', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('ZOPT-V2W', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('AWAV-V2A', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
d187 22
a208 22
      NFAIL = NFAIL + CLOSURE('FREQ-GRI', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('AFRQ-GRI', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('ENER-GRI', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('WAVN-GRI', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('VRAD-GRI', RESTFRQ, 0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('WAVE-GRI', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('VOPT-GRI', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('ZOPT-GRI', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('AWAV-GRI', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('VELO-GRI', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('BETA-GRI', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
d226 4
a229 4
      NFAIL = NFAIL + CLOSURE('AWAV-GRA', 0D0,     0D0, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
      NFAIL = NFAIL + CLOSURE('VELO-GRA', 0D0, RESTWAV, NAXISJ, CRPIXJ,
     :                        CDELTX, CRVALX)
a233 11

      IF (NFAIL.NE.0) THEN
        WRITE (*, 80) NFAIL
 80     FORMAT (/,'FAIL:',I5,' closure residuals exceed reporting ',
     :    'tolerance.')
      ELSE
        WRITE (*, 90)
 90     FORMAT (/,'PASS: All closure residuals are within reporting ',
     :    'tolerance.')
      END IF

d238 2
a239 2
      INTEGER FUNCTION CLOSURE (CTYPES, RESTFRQ, RESTWAV, NAXISJ,
     :  CRPIXJ, CDELTX, CRVALX)
d244 1
a244 2
      INTEGER   J, NAXISJ, NFAIL, RESTREQ, STAT1(NSPEC), STAT2(NSPEC),
     :          STATUS
d320 1
a322 2
      NFAIL = 0
      RESIDMAX = 0D0
a341 1
          NFAIL = NFAIL + 1
d345 1
a345 1
     :           '          w =',1PE20.12,',  resid =',1PE8.1)
d350 1
a350 1
 90   FORMAT (A,': Maximum closure residual =',1PE8.1,' pixel')
d407 1
a407 2
      CLOSURE = NFAIL

@


4.6
log
@WCSLIB 4.6
@
text
@d3 2
a4 2
* WCSLIB 4.6 - an implementation of the FITS WCS standard.
* Copyright (C) 1995-2010, Mark Calabretta
d31 1
a31 1
* $Id: tspc.f,v 4.5.1.1 2010/07/16 07:05:32 cal103 Exp cal103 $
d255 2
@


4.6.1.1
log
@WCSLIB 4.6 development branch.
@
text
@d31 1
a31 1
* $Id: tspc.f,v 4.6 2010/11/16 06:15:32 cal103 Exp $
@


4.6.1.2
log
@Updated date in copyright notice.
@
text
@d4 1
a4 1
* Copyright (C) 1995-2011, Mark Calabretta
d31 1
a31 1
* $Id: tspc.f,v 4.6.1.1 2010/11/16 06:16:19 cal103 Exp cal103 $
@


4.6.1.3
log
@Use an EQUIVALENCE to ensure that the SPC array is aligned on a
DOUBLE PRECISION boundary.
@
text
@d31 1
a31 1
* $Id: tspc.f,v 4.6.1.2 2011/01/14 06:34:16 cal103 Exp cal103 $
a254 2
      DOUBLE PRECISION DUMMY
      EQUIVALENCE (SPC,DUMMY)
@


4.5
log
@WCSLIB 4.5
@
text
@d3 1
a3 1
* WCSLIB 4.5 - an implementation of the FITS WCS standard.
d31 1
a31 1
* $Id: tspc.f,v 4.4.1.3 2010/07/14 04:49:59 cal103 Exp cal103 $
@


4.5.1.1
log
@WCSLIB 4.5 development branch.
@
text
@d31 1
a31 1
* $Id: tspc.f,v 4.5 2010/07/16 07:01:26 cal103 Exp $
@


4.4
log
@WCSLIB 4.4
@
text
@d3 2
a4 2
* WCSLIB 4.4 - an implementation of the FITS WCS standard.
* Copyright (C) 1995-2009, Mark Calabretta
d31 1
a31 1
* $Id: tspc.f,v 4.3.1.3 2009/08/06 02:50:21 cal103 Exp cal103 $
d402 1
a402 1
      READ (5, *, END=130)
@


4.4.1.1
log
@WCSLIB 4.4 development branch.
@
text
@d31 1
a31 1
* $Id: tspc.f,v 4.4 2009/08/06 07:52:43 cal103 Exp $
@


4.4.1.2
log
@Updated date in copyright notice.
@
text
@d4 1
a4 1
* Copyright (C) 1995-2010, Mark Calabretta
d31 1
a31 1
* $Id: tspc.f,v 4.4.1.1 2009/08/10 08:55:07 cal103 Exp cal103 $
@


4.4.1.3
log
@Change READ(5,...) to READ(*,...) which is more generic.
@
text
@d31 1
a31 1
* $Id: tspc.f,v 4.4.1.2 2010/01/19 03:44:57 cal103 Exp cal103 $
d402 1
a402 1
      READ (*, *, END=130)
@


4.3
log
@WCSLIB 4.3
@
text
@d3 2
a4 2
*   WCSLIB 4.3 - an implementation of the FITS WCS standard.
*   Copyright (C) 1995-2007, Mark Calabretta
d6 1
a6 1
*   This file is part of WCSLIB.
d8 4
a11 4
*   WCSLIB is free software: you can redistribute it and/or modify
*   it under the terms of the GNU Lesser General Public License as
*   published by the Free Software Foundation, either version 3 of
*   the License, or (at your option) any later version.
d13 4
a16 4
*   WCSLIB 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 Lesser General Public License for more details.
d18 2
a19 2
*   You should have received a copy of the GNU Lesser General Public
*   License along with WCSLIB.  If not, see http://www.gnu.org/licenses.
d21 7
a27 7
*   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
d29 3
a31 3
*   Author: Mark Calabretta, Australia Telescope National Facility
*   http://www.atnf.csiro.au/~mcalabre/index.html
*   $Id: tspc.f,v 4.2.1.4 2007/12/03 05:37:50 cal103 Exp cal103 $
d37 1
a37 1
*   TSPC tests the spectral transformation driver routines for closure.
d264 3
a266 3
         WRITE (*, 5) STATUS, CTYPES
 5       FORMAT ('ERROR',I2,' from SPCXPS for',A,'.')
         RETURN
d273 8
a280 8
*        KPNO MARS spectrograph grism parameters.
         STATUS = SPCPUT (SPC, SPC_PV, MARS(0), 0)
         STATUS = SPCPUT (SPC, SPC_PV, MARS(1), 1)
         STATUS = SPCPUT (SPC, SPC_PV, MARS(2), 2)
         STATUS = SPCPUT (SPC, SPC_PV, MARS(3), 3)
         STATUS = SPCPUT (SPC, SPC_PV, MARS(4), 4)
         STATUS = SPCPUT (SPC, SPC_PV, MARS(5), 5)
         STATUS = SPCPUT (SPC, SPC_PV, MARS(6), 6)
d285 1
a285 1
         SPEC1(J) = (J - CRPIXJ)*CDELTS
d305 3
a307 3
         WRITE (*, 30) STATUS
 30      FORMAT ('SPCX2S ERROR',I2,'.')
         RETURN
d313 3
a315 3
         WRITE (*, 40) STATUS
 40      FORMAT ('SPCS2X ERROR',I2,'.')
         RETURN
d323 22
a344 22
         IF (STAT1(J).NE.0) THEN
            WRITE (*, 50) CTYPES, SPEC1(J), STYPE, STAT1(J)
 50         FORMAT (A,': w =',1PE20.12,' -> ',A,' = ???, stat = ',I2)
            GO TO 80
         END IF

         IF (STAT2(J).NE.0) THEN
            WRITE (*, 60) CTYPES, SPEC1(J), STYPE, SPEC2(J), STAT2(J)
 60         FORMAT (A,': w =',1PE20.12,' -> ',A,' =',1PE20.12,
     :              ' -> w = ???, stat = ',I2)
            GO TO 80
         END IF

         RESID = ABS((CLOS(J) - SPEC1(J))/CDELTS)
         IF (RESID.GT.RESIDMAX) RESIDMAX = RESID

         IF (RESID.GT.TOL) THEN
            WRITE (*, 70) CTYPES, SPEC1(J), STYPE, SPEC2(J), CLOS(J),
     :                    RESID
 70         FORMAT (A,': w =',1PE20.12,' -> ',A,' =',1PE20.12,' ->',/,
     :             '          w =',1PE20.12,',  resid =',1PE20.12)
         END IF
d360 4
a363 4
         X(J) = REAL(J)
         Y(J) = REAL(SPEC2(J) - (CRVALS + SPEC1(J)))
         IF (Y(J).GT.YMAX) YMAX = Y(J)
         IF (Y(J).LT.YMIN) YMIN = Y(J)
d368 3
a370 3
         TMP  = YMIN
         YMIN = YMAX
         YMAX = TMP
d382 1
a382 1
         IF (SNAME(J:J).NE.' ') GO TO 120
d389 1
a389 1
     :        0, -0.5, 0.0, 0.5, -0.5, 0.0)
d392 2
a393 2
     :        REAL(YMIN/CDELTS), REAL(YMAX/CDELTS), 0.0, 0, 0.5, 0.0,
     :        0.5, 0.1, 0.0)
@


4.3.1.1
log
@WCSLIB 4.3 development branch.
@
text
@d3 2
a4 2
*   WCSLIB 4.4 - an implementation of the FITS WCS standard.
*   Copyright (C) 1995-2008, Mark Calabretta
d31 1
a31 1
*   $Id: tspc.f,v 4.3 2007/12/27 05:42:52 cal103 Exp cal103 $
@


4.3.1.2
log
@Changed indentation.
@
text
@d3 2
a4 2
* WCSLIB 4.4 - an implementation of the FITS WCS standard.
* Copyright (C) 1995-2009, Mark Calabretta
d6 1
a6 1
* This file is part of WCSLIB.
d8 4
a11 4
* WCSLIB is free software: you can redistribute it and/or modify it
* under the terms of the GNU Lesser General Public License as published
* by the Free Software Foundation, either version 3 of the License, or
* (at your option) any later version.
d13 4
a16 4
* WCSLIB 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 Lesser General Public
* License for more details.
d18 2
a19 2
* You should have received a copy of the GNU Lesser General Public
* License along with WCSLIB.  If not, see http://www.gnu.org/licenses.
d21 7
a27 7
* 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
d29 3
a31 3
* Author: Mark Calabretta, Australia Telescope National Facility
* http://www.atnf.csiro.au/~mcalabre/index.html
* $Id: tspc.f,v 4.3.1.1 2007/12/27 13:25:35 cal103 Exp cal103 $
d37 1
a37 1
* TSPC tests the spectral transformation driver routines for closure.
@


4.3.1.3
log
@Changed indentation.
@
text
@d31 1
a31 1
* $Id: tspc.f,v 4.3.1.2 2009/07/22 07:28:07 cal103 Exp cal103 $
d264 3
a266 3
        WRITE (*, 5) STATUS, CTYPES
 5      FORMAT ('ERROR',I2,' from SPCXPS for',A,'.')
        RETURN
d273 8
a280 8
*       KPNO MARS spectrograph grism parameters.
        STATUS = SPCPUT (SPC, SPC_PV, MARS(0), 0)
        STATUS = SPCPUT (SPC, SPC_PV, MARS(1), 1)
        STATUS = SPCPUT (SPC, SPC_PV, MARS(2), 2)
        STATUS = SPCPUT (SPC, SPC_PV, MARS(3), 3)
        STATUS = SPCPUT (SPC, SPC_PV, MARS(4), 4)
        STATUS = SPCPUT (SPC, SPC_PV, MARS(5), 5)
        STATUS = SPCPUT (SPC, SPC_PV, MARS(6), 6)
d285 1
a285 1
        SPEC1(J) = (J - CRPIXJ)*CDELTS
d305 3
a307 3
        WRITE (*, 30) STATUS
 30     FORMAT ('SPCX2S ERROR',I2,'.')
        RETURN
d313 3
a315 3
        WRITE (*, 40) STATUS
 40     FORMAT ('SPCS2X ERROR',I2,'.')
        RETURN
d323 22
a344 22
        IF (STAT1(J).NE.0) THEN
          WRITE (*, 50) CTYPES, SPEC1(J), STYPE, STAT1(J)
 50       FORMAT (A,': w =',1PE20.12,' -> ',A,' = ???, stat = ',I2)
          GO TO 80
        END IF

        IF (STAT2(J).NE.0) THEN
          WRITE (*, 60) CTYPES, SPEC1(J), STYPE, SPEC2(J), STAT2(J)
 60       FORMAT (A,': w =',1PE20.12,' -> ',A,' =',1PE20.12,
     :            ' -> w = ???, stat = ',I2)
          GO TO 80
        END IF

        RESID = ABS((CLOS(J) - SPEC1(J))/CDELTS)
        IF (RESID.GT.RESIDMAX) RESIDMAX = RESID

        IF (RESID.GT.TOL) THEN
          WRITE (*, 70) CTYPES, SPEC1(J), STYPE, SPEC2(J), CLOS(J),
     :                  RESID
 70       FORMAT (A,': w =',1PE20.12,' -> ',A,' =',1PE20.12,' ->',/,
     :           '          w =',1PE20.12,',  resid =',1PE20.12)
        END IF
d360 4
a363 4
        X(J) = REAL(J)
        Y(J) = REAL(SPEC2(J) - (CRVALS + SPEC1(J)))
        IF (Y(J).GT.YMAX) YMAX = Y(J)
        IF (Y(J).LT.YMIN) YMIN = Y(J)
d368 3
a370 3
        TMP  = YMIN
        YMIN = YMAX
        YMAX = TMP
d382 1
a382 1
        IF (SNAME(J:J).NE.' ') GO TO 120
d389 1
a389 1
     :            0, -0.5, 0.0, 0.5, -0.5, 0.0)
d392 2
a393 2
     :            REAL(YMIN/CDELTS), REAL(YMAX/CDELTS), 0.0, 0, 0.5,
     :            0.0, 0.5, 0.1, 0.0)
@


4.2
log
@WCSLIB 4.2: identify the name of the program in the output; removed comment
on catching IEEE floating point exceptions with the Sun Fortran compiler.
@
text
@d3 2
a4 2
*   WCSLIB 4.2 - an implementation of the FITS WCS convention.
*   Copyright (C) 1995-2005, Mark Calabretta
d6 1
a6 4
*   WCSLIB 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.
d8 4
a11 4
*   WCSLIB 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.
d13 7
a19 3
*   You should have received a copy of the GNU General Public License along
*   with WCSLIB; if not, write to the Free Software Foundation, Inc.,
*   59 Temple Place, Suite 330, Boston, MA  02111-1307, USA
d31 1
a31 1
*   $Id: tspc.f,v 4.1 2005/08/26 13:50:14 cal103 Exp cal103 $
d401 1
a401 1
      WRITE (*, '($,A)') 'Type <RETURN> for next page: '
@


4.2.1.1
log
@WCSLIB 4.2 development branch.
@
text
@d3 1
a3 1
*   WCSLIB 4.3 - an implementation of the FITS WCS convention.
d30 1
a30 1
*   $Id: tspc.f,v 4.2 2005/09/21 13:37:53 cal103 Exp cal103 $
@


4.2.1.2
log
@Fixed '$' formatting warning produced by gfortran.
@
text
@d4 1
a4 1
*   Copyright (C) 1995-2007, Mark Calabretta
d30 1
a30 1
*   $Id: tspc.f,v 4.2.1.1 2005/12/05 01:37:43 cal103 Exp cal103 $
d400 1
a400 1
      WRITE (*, '(A,$)') 'Type <RETURN> for next page: '
@


4.2.1.3
log
@Fixed long lines in the GNU copyright notice.
@
text
@d6 4
a9 4
*   WCSLIB 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.
d11 4
a14 4
*   WCSLIB 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.
d16 3
a18 3
*   You should have received a copy of the GNU General Public License
*   along with WCSLIB; if not, write to the Free Software Foundation,
*   Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA
d30 1
a30 1
*   $Id: tspc.f,v 4.2.1.2 2007/07/05 07:15:16 cal103 Exp cal103 $
@


4.2.1.4
log
@Switched to LGPL 3.0.
@
text
@d3 1
a3 1
*   WCSLIB 4.3 - an implementation of the FITS WCS standard.
d6 4
a9 6
*   This file is part of WCSLIB.
*
*   WCSLIB is free software: you can redistribute it and/or modify
*   it under the terms of the GNU Lesser General Public License as
*   published by the Free Software Foundation, either version 3 of
*   the License, or (at your option) any later version.
d13 2
a14 2
*   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
*   GNU Lesser General Public License for more details.
d16 3
a18 2
*   You should have received a copy of the GNU Lesser General Public
*   License along with WCSLIB.  If not, see http://www.gnu.org/licenses.
d30 1
a30 1
*   $Id: tspc.f,v 4.2.1.3 2007/08/02 06:40:51 cal103 Exp cal103 $
@


4.1
log
@WCSLIB 4.1: set the rest frequency and/or wavelength to 0.0 in all of the
closure tests to check that it is handled properly; condensed the code
significantly by using SPCXPS to construct the spectral axis; renamed
certain variables to match Paper III.
@
text
@d3 1
a3 1
*   WCSLIB 4.1 - an implementation of the FITS WCS convention.
d30 1
a30 1
*   $Id: tspc.f,v 4.0 2005/02/04 12:45:34 cal103 Exp cal103 $
a53 6
*     Uncomment the following two lines to raise SIGFPE on floating
*     point exceptions for the Sun FORTRAN compiler.  This signal can
*     be caught within 'dbx' by issuing the command "catch FPE".
*#include <f77_floatingpoint.h>
*      call ieee_handler ('set', 'common', SIGFPE_ABORT)

d55 4
a58 3
 10   FORMAT (/,'Testing closure of WCSLIB spectral transformation ',
     :        'routines',/'----------------------------------------',
     :        '------------------')
@


4.0
log
@WCSLIB 4.0: changed from LGPL to GPL.
@
text
@d3 1
a3 1
*   WCSLIB 4.0 - an implementation of the FITS WCS convention.
d30 1
a30 1
*   $Id: tspc.f,v 3.6 2004/08/25 06:33:14 cal103 Exp cal103 $
d83 1
a83 1
      CALL CLOSURE('WAVE-F2W', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d85 1
a85 1
      CALL CLOSURE('VOPT-F2W', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d87 1
a87 1
      CALL CLOSURE('ZOPT-F2W', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d89 1
a89 1
      CALL CLOSURE('AWAV-F2A', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d91 1
a91 1
      CALL CLOSURE('VELO-F2V', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d93 1
a93 1
      CALL CLOSURE('BETA-F2V', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d107 1
a107 1
      CALL CLOSURE('FREQ-W2F', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d109 1
a109 1
      CALL CLOSURE('AFRQ-W2F', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d111 1
a111 1
      CALL CLOSURE('ENER-W2F', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d113 1
a113 1
      CALL CLOSURE('WAVN-W2F', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d115 1
a115 1
      CALL CLOSURE('VRAD-W2F', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d117 1
a117 1
      CALL CLOSURE('AWAV-W2A', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d119 1
a119 1
      CALL CLOSURE('VELO-W2V', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d121 1
a121 1
      CALL CLOSURE('BETA-W2V', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d129 1
a129 1
      CALL CLOSURE('FREQ-A2F', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d131 1
a131 1
      CALL CLOSURE('AFRQ-A2F', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d133 1
a133 1
      CALL CLOSURE('ENER-A2F', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d135 1
a135 1
      CALL CLOSURE('WAVN-A2F', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d137 1
a137 1
      CALL CLOSURE('VRAD-A2F', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d139 1
a139 1
      CALL CLOSURE('WAVE-A2W', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d141 1
a141 1
      CALL CLOSURE('VOPT-A2W', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d143 1
a143 1
      CALL CLOSURE('ZOPT-A2W', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d145 1
a145 1
      CALL CLOSURE('VELO-A2V', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d147 1
a147 1
      CALL CLOSURE('BETA-A2V', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d161 1
a161 1
      CALL CLOSURE('FREQ-V2F', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d163 1
a163 1
      CALL CLOSURE('AFRQ-V2F', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d165 1
a165 1
      CALL CLOSURE('ENER-V2F', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d167 1
a167 1
      CALL CLOSURE('WAVN-V2F', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d169 1
a169 1
      CALL CLOSURE('VRAD-V2F', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d171 1
a171 1
      CALL CLOSURE('WAVE-V2W', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d173 1
a173 1
      CALL CLOSURE('VOPT-V2W', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d175 1
a175 1
      CALL CLOSURE('ZOPT-V2W', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d177 1
a177 1
      CALL CLOSURE('AWAV-V2A', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d191 1
a191 1
      CALL CLOSURE('FREQ-GRI', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d193 1
a193 1
      CALL CLOSURE('AFRQ-GRI', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d195 1
a195 1
      CALL CLOSURE('ENER-GRI', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d197 1
a197 1
      CALL CLOSURE('WAVN-GRI', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d199 1
a199 1
      CALL CLOSURE('VRAD-GRI', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d201 1
a201 1
      CALL CLOSURE('WAVE-GRI', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d203 1
a203 1
      CALL CLOSURE('VOPT-GRI', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d205 1
a205 1
      CALL CLOSURE('ZOPT-GRI', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d207 1
a207 1
      CALL CLOSURE('AWAV-GRI', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d209 1
a209 1
      CALL CLOSURE('VELO-GRI', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d211 1
a211 1
      CALL CLOSURE('BETA-GRI', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d230 1
a230 1
      CALL CLOSURE('AWAV-GRA', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d232 1
a232 1
      CALL CLOSURE('VELO-GRA', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ, CDELTX,
d242 1
a242 1
      SUBROUTINE CLOSURE (CTYPE, RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
d248 1
a248 1
      INTEGER   J, NAXISJ, STAT1(NSPEC), STAT2(NSPEC), STATUS
d251 1
a251 1
     :          CRVALX, DQDX, DSDQ, MARS(0:6), RESID, RESIDMAX, RESTFRQ,
d253 2
a254 2
      CHARACTER CTYPE*8, CTYPES*4, CTYPEX*4, QTYPE, STYPE*32, TITLE*80,
     :          UNITS*8, XTYPE, YLAB*80
d264 10
d276 1
a276 11
*     Construct a linear axis of the required X-type.
      XTYPE = CTYPE(6:6)
      IF (XTYPE.EQ.'F') THEN
         CTYPEX = 'FREQ'
      ELSE IF (XTYPE.EQ.'W') THEN
         CTYPEX = 'WAVE'
      ELSE IF (XTYPE.EQ.'A') THEN
         CTYPEX = 'AWAV'
      ELSE IF (XTYPE.EQ.'V') THEN
         CTYPEX = 'VELO'
      ELSE IF (XTYPE.EQ.'G') THEN
a284 84

*        CDELTX and CRVALX were given as wavelengths...
         IF (CTYPE(8:8).EQ.'I') THEN
*           ...in vacuum.
            XTYPE  = 'W'
            CTYPEX = 'WAVE'
         ELSE
*           ...in air.
            XTYPE  = 'A'
            CTYPEX = 'AWAV'
         END IF
      ELSE
         RETURN
      END IF

      STATUS = SPECX(CTYPEX, CRVALX, RESTFRQ, RESTWAV, SPX)

*     What is the required spectral type?
      CTYPES = CTYPE(1:4)
      DSDQ   = 1D0
      IF (CTYPES.EQ.'FREQ') THEN
         STYPE  = 'Frequency'
         UNITS  = '(Hz)'
         CRVALS = SPX_FREQ
         QTYPE  = 'F'
      ELSE IF (CTYPES.EQ.'AFRQ') THEN
         STYPE  = 'Angular frequency'
         UNITS  = '(deg/s)'
         CRVALS = SPX_AFRQ
         DSDQ   = SPX_DAFRQFREQ
         QTYPE  = 'F'
      ELSE IF (CTYPES.EQ.'ENER') THEN
         STYPE  = 'Photon energy'
         UNITS  = '(J)'
         CRVALS = SPX_ENER
         DSDQ   = SPX_DENERFREQ
         QTYPE  = 'F'
      ELSE IF (CTYPES.EQ.'WAVN') THEN
         STYPE  = 'Wavenumber'
         UNITS  = '(1/m)'
         CRVALS = SPX_WAVN
         DSDQ   = SPX_DWAVNFREQ
         QTYPE  = 'F'
      ELSE IF (CTYPES.EQ.'VRAD') THEN
         STYPE  = 'Radio velocity'
         UNITS  = '(m/s)'
         CRVALS = SPX_VRAD
         DSDQ   = SPX_DVRADFREQ
         QTYPE  = 'F'
      ELSE IF (CTYPES.EQ.'WAVE') THEN
         STYPE  = 'Vacuum wavelength'
         UNITS  = '(m)'
         CRVALS = SPX_WAVE
         QTYPE  = 'W'
      ELSE IF (CTYPES.EQ.'VOPT') THEN
         STYPE  = 'Optical velocity'
         UNITS  = '(m/s)'
         CRVALS = SPX_VOPT
         DSDQ   = SPX_DVOPTWAVE
         QTYPE  = 'W'
      ELSE IF (CTYPES.EQ.'ZOPT') THEN
         STYPE  = 'Redshift'
         UNITS  = ' '
         CRVALS = SPX_ZOPT
         DSDQ   = SPX_DZOPTWAVE
         QTYPE  = 'W'
      ELSE IF (CTYPES.EQ.'AWAV') THEN
         STYPE  = 'Air wavelength'
         UNITS  = '(m)'
         CRVALS = SPX_AWAV
         QTYPE  = 'A'
      ELSE IF (CTYPES.EQ.'VELO') THEN
         STYPE  = 'Relativistic velocity'
         UNITS  = '(m/s)'
         CRVALS = SPX_VELO
         QTYPE  = 'V'
      ELSE IF (CTYPES.EQ.'BETA') THEN
         STYPE  = 'Velocity ratio (v/c)'
         UNITS  = ' '
         CRVALS = SPX_BETA
         DSDQ   = SPX_DBETAVELO
         QTYPE  = 'V'
      ELSE
         RETURN
a286 38
*     Find dQ/dX.
      DQDX = 1D0
      IF (XTYPE.EQ.'F') THEN
         IF (QTYPE.EQ.'W') THEN
            DQDX = SPX_DWAVEFREQ
         ELSE IF (QTYPE.EQ.'A') THEN
            DQDX = SPX_DAWAVFREQ
         ELSE IF (QTYPE.EQ.'V') THEN
            DQDX = SPX_DVELOFREQ
         END IF
      ELSE IF (XTYPE.EQ.'W') THEN
         IF (QTYPE.EQ.'F') THEN
            DQDX = SPX_DFREQWAVE
         ELSE IF (QTYPE.EQ.'A') THEN
            DQDX = SPX_DAWAVWAVE
         ELSE IF (QTYPE.EQ.'V') THEN
            DQDX = SPX_DVELOWAVE
         END IF
      ELSE IF (XTYPE.EQ.'A') THEN
         IF (QTYPE.EQ.'F') THEN
            DQDX = SPX_DFREQAWAV
         ELSE IF (QTYPE.EQ.'W') THEN
            DQDX = SPX_DWAVEAWAV
         ELSE IF (QTYPE.EQ.'V') THEN
            DQDX = SPX_DVELOAWAV
         END IF
      ELSE IF (XTYPE.EQ.'V') THEN
         IF (QTYPE.EQ.'F') THEN
            DQDX = SPX_DFREQVELO
         ELSE IF (QTYPE.EQ.'W') THEN
            DQDX = SPX_DWAVEVELO
         ELSE IF (QTYPE.EQ.'A') THEN
            DQDX = SPX_DAWAVVELO
         END IF
      END IF

      CDELTS = DSDQ * DQDX * CDELTX

d304 1
a304 1
      STATUS = SPCPUT (SPC, SPC_CODE, CTYPE(6:8), 0)
d310 1
a310 1
 30      FORMAT ('SPCX2S: ERROR',I2,'.')
d318 1
a318 1
 40      FORMAT ('SPCS2X: ERROR',I2,'.')
d325 1
d328 1
a328 1
            WRITE (*, 50) CTYPE, SPEC1(J), CTYPES, STAT1(J)
d334 1
a334 1
            WRITE (*, 60) CTYPE, SPEC1(J), CTYPES, SPEC2(J), STAT2(J)
d344 1
a344 1
            WRITE (*, 70) CTYPE, SPEC1(J), CTYPES, SPEC2(J), CLOS(J),
d351 1
a351 1
      WRITE (*, 90) CTYPE, RESIDMAX
d383 4
a386 2
      DO 110 J = 32, 1, -1
         IF (STYPE(J:J).NE.' ') GO TO 120
d388 2
a389 2
 120  YLAB  = STYPE(:J) // ' - correction ' // UNITS
      TITLE = CTYPE // ':  CRVALk + w ' // UNITS
@


3.6
log
@WCSLIB 3.6: changed "WRITE (6, ...)" to "WRITE (*, ...)" as being standard
FORTRAN and notionally more portable; in error messages, print "ERROR"
(in uppercase) - POSIX standard.
@
text
@d3 2
a4 2
*   WCSLIB 3.6 - an implementation of the FITS WCS convention.
*   Copyright (C) 1995-2004, Mark Calabretta
d6 4
a9 4
*   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.
d11 4
a14 4
*   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.
d16 3
a18 3
*   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.
d30 1
a30 1
*   $Id: tspc.f,v 3.5 2004/06/28 04:51:50 mcalabre Exp mcalabre $
@


3.5
log
@WCSLIB 3.5
@
text
@d3 1
a3 1
*   WCSLIB 3.5 - an implementation of the FITS WCS convention.
d30 1
a30 1
*   $Id: tspc.f,v 3.4 2004/02/11 00:04:18 mcalabre Exp mcalabre $
d60 1
a60 1
      WRITE (6, 10)
d79 1
a79 1
      WRITE (6, 20) X1*1D-9, X2*1D-9, CDELTX*1D-3
d103 1
a103 1
      WRITE (6, 30) INT(X1*1D9), INT(X2*1D9), CDELTX*1D9
d125 1
a125 1
      WRITE (6, 40) INT(X1*1D9), INT(X2*1D9), CDELTX*1D9
d157 1
a157 1
      WRITE (6, 50) INT(X1), INT(X2), INT(CDELTX)
d187 1
a187 1
      WRITE (6, 60) INT(X1*1D9), INT(X2*1D9), CDELTX*1D9
d226 1
a226 1
      WRITE (6, 70) INT(X1*1D9), INT(X2*1D9), CDELTX*1D9
d414 1
a414 1
      WRITE (6, 20) CTYPES, CRVALS+SPEC1(1), CRVALS+SPEC1(NAXISJ),
d431 2
a432 2
         WRITE (6, 30) STATUS
 30      FORMAT ('SPCX2S: Error',I2,'.')
d439 2
a440 2
         WRITE (6, 40) STATUS
 40      FORMAT ('SPCS2X: Error',I2,'.')
d449 1
a449 1
            WRITE (6, 50) CTYPE, SPEC1(J), CTYPES, STAT1(J)
d455 1
a455 1
            WRITE (6, 60) CTYPE, SPEC1(J), CTYPES, SPEC2(J), STAT2(J)
d465 1
a465 1
            WRITE (6, 70) CTYPE, SPEC1(J), CTYPES, SPEC2(J), CLOS(J),
d472 1
a472 1
      WRITE (6, 90) CTYPE, RESIDMAX
d524 1
a524 1
      WRITE (6, '($,A)') 'Type <RETURN> for next page: '
d526 1
a526 1
 130  WRITE (6, *)
@


3.4
log
@WCSLIB 3.4
@
text
@d3 1
a3 1
*   WCSLIB 3.4 - an implementation of the FITS WCS convention.
d28 3
d32 1
a37 1
*   $Id: tspc.f,v 3.3 2003/10/21 08:36:48 mcalabre Exp mcalabre $
@


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
d34 1
a34 1
*   $Id: tspc.f,v 3.2 2003/09/09 03:54:37 mcalabre Exp mcalabre $
@


3.2
log
@WCSLIB 3.2
@
text
@d3 1
a3 1
*   WCSLIB 3.2 - an implementation of the FITS WCS convention.
d34 1
a34 1
*   $Id: tspc.f,v 3.1 2003/04/29 02:04:32 mcalabre Exp mcalabre $
@


3.1
log
@WCSLIB 3.1
Fixed a non-standard FORTRAN construct; minor refinement of PGPLOT paging.
@
text
@d3 1
a3 1
*   WCSLIB 3.1 - an implementation of the FITS WCS convention.
d34 1
a34 1
*   $Id: tspc.f,v 3.1 2003/04/28 06:45:44 mcalabre Exp $
@


3.0
log
@WCSLIB 3.0
@
text
@d3 1
a3 1
*   WCSLIB 3.0 - an implementation of the FITS WCS convention.
d34 1
a34 1
*   $Id$
d36 1
d80 12
a91 12
      CALL CLOSURE(NSPEC, 'WAVE-F2W', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'VOPT-F2W', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'ZOPT-F2W', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'AWAV-F2A', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'VELO-F2V', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'BETA-F2V', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
d104 16
a119 16
      CALL CLOSURE(NSPEC, 'FREQ-W2F', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'AFRQ-W2F', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'ENER-W2F', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'WAVN-W2F', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'VRAD-W2F', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'AWAV-W2A', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'VELO-W2V', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'BETA-W2V', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
d126 20
a145 20
      CALL CLOSURE(NSPEC, 'FREQ-A2F', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'AFRQ-A2F', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'ENER-A2F', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'WAVN-A2F', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'VRAD-A2F', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'WAVE-A2W', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'VOPT-A2W', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'ZOPT-A2W', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'VELO-A2V', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'BETA-A2V', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
d158 18
a175 18
      CALL CLOSURE(NSPEC, 'FREQ-V2F', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'AFRQ-V2F', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'ENER-V2F', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'WAVN-V2F', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'VRAD-V2F', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'WAVE-V2W', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'VOPT-V2W', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'ZOPT-V2W', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'AWAV-V2A', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
d188 22
a209 22
      CALL CLOSURE(NSPEC, 'FREQ-GRI', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'AFRQ-GRI', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'ENER-GRI', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'WAVN-GRI', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'VRAD-GRI', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'WAVE-GRI', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'VOPT-GRI', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'ZOPT-GRI', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'AWAV-GRI', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'VELO-GRI', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'BETA-GRI', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
d227 4
a230 4
      CALL CLOSURE(NSPEC, 'AWAV-GRA', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
      CALL CLOSURE(NSPEC, 'VELO-GRA', RESTFRQ, RESTWAV, NAXISJ, CRPIXJ,
     :             CDELTX, CRVALX)
d239 2
a240 2
      SUBROUTINE CLOSURE (NSPEC, CTYPE, RESTFRQ, RESTWAV, NAXISJ,
     :   CRPIXJ, CDELTX, CRVALX)
d242 4
a245 1
      INTEGER   J, NAXISJ, NSPEC, STAT1(NSPEC), STAT2(NSPEC), STATUS
d521 3
a523 4
      CALL PGASK(1)
      CALL PGPAGE()

      WRITE (6, *)
@
