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


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

8.6
date	2026.03.29.13.53.56;	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.16;	author mcalabre;	state Exp;
branches
	8.4.1.1;
next	8.3;

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

8.2
date	2023.11.16.10.00.29;	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.04;	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.48;	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.01;	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.51;	author mcalabre;	state Exp;
branches
	7.4.1.1;
next	7.3;

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

7.2
date	2020.03.09.07.31.23;	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.39;	author mcalabre;	state Exp;
branches
	6.3.1.1;
next	6.2;

6.2
date	2018.10.20.10.03.13;	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.41;	author mcalabre;	state Exp;
branches
	5.20.1.1;
next	5.19;

5.19
date	2018.07.26.15.37.04;	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.23;	author mcalabre;	state Exp;
branches
	5.17.1.1;
next	5.16;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

4.11
date	2012.02.20.23.30.02;	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.29;	author cal103;	state Exp;
branches
	4.9.1.1;
next	4.8;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

4.2.1.4
date	2007.07.11.02.01.30;	author cal103;	state Exp;
branches;
next	4.2.1.5;

4.2.1.5
date	2007.07.27.08.43.10;	author cal103;	state Exp;
branches;
next	4.2.1.6;

4.2.1.6
date	2007.12.03.05.02.17;	author cal103;	state Exp;
branches;
next	;

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

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

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

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

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

4.4.1.3
date	2010.01.19.03.42.50;	author cal103;	state Exp;
branches;
next	4.4.1.4;

4.4.1.4
date	2010.07.07.13.16.25;	author cal103;	state Exp;
branches;
next	4.4.1.5;

4.4.1.5
date	2010.07.09.07.57.14;	author cal103;	state Exp;
branches;
next	;

4.5.1.1
date	2010.07.16.07.05.31;	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.33.16;	author cal103;	state Exp;
branches;
next	4.6.1.3;

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

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

4.7.1.2
date	2011.07.21.03.43.08;	author cal103;	state Exp;
branches;
next	4.7.1.3;

4.7.1.3
date	2011.08.09.02.43.50;	author cal103;	state Exp;
branches;
next	4.7.1.4;

4.7.1.4
date	2011.08.10.04.35.07;	author cal103;	state Exp;
branches;
next	4.7.1.5;

4.7.1.5
date	2011.08.12.05.42.29;	author cal103;	state Exp;
branches;
next	4.7.1.6;

4.7.1.6
date	2011.08.15.03.22.25;	author cal103;	state Exp;
branches;
next	;

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

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

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

4.9.1.1
date	2012.01.24.05.41.45;	author cal103;	state Exp;
branches;
next	4.9.1.2;

4.9.1.2
date	2012.02.02.08.17.39;	author cal103;	state Exp;
branches;
next	;

4.10.1.1
date	2012.02.05.23.42.46;	author cal103;	state Exp;
branches;
next	4.10.1.2;

4.10.1.2
date	2012.02.20.23.10.24;	author cal103;	state Exp;
branches;
next	;

4.11.1.1
date	2012.02.20.23.31.13;	author cal103;	state Exp;
branches;
next	4.11.1.2;

4.11.1.2
date	2012.02.29.07.16.19;	author cal103;	state Exp;
branches;
next	;

4.12.1.1
date	2012.02.29.07.59.10;	author cal103;	state Exp;
branches;
next	4.12.1.2;

4.12.1.2
date	2012.03.14.06.36.28;	author cal103;	state Exp;
branches;
next	;

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

4.13.1.2
date	2012.07.12.15.28.47;	author cal103;	state Exp;
branches;
next	4.13.1.3;

4.13.1.3
date	2012.07.13.03.34.20;	author cal103;	state Exp;
branches;
next	;

4.14.1.1
date	2012.07.13.10.04.44;	author cal103;	state Exp;
branches;
next	4.14.1.2;

4.14.1.2
date	2012.09.18.09.30.22;	author cal103;	state Exp;
branches;
next	;

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

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

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

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

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

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

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

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

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

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

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

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

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

4.25.1.2
date	2015.01.06.01.01.06;	author mcalabre;	state Exp;
branches;
next	4.25.1.3;

4.25.1.3
date	2015.03.05.10.09.30;	author mcalabre;	state Exp;
branches;
next	4.25.1.4;

4.25.1.4
date	2015.03.12.07.21.58;	author mcalabre;	state Exp;
branches;
next	4.25.1.5;

4.25.1.5
date	2015.04.03.01.30.55;	author mcalabre;	state Exp;
branches;
next	;

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

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

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

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

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

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

5.6.1.1
date	2015.06.14.07.14.44;	author mcalabre;	state Exp;
branches;
next	5.6.1.2;

5.6.1.2
date	2015.06.18.08.13.03;	author mcalabre;	state Exp;
branches;
next	;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

5.18.1.2
date	2018.07.25.00.22.45;	author mcalabre;	state Exp;
branches;
next	;

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

5.20.1.1
date	2018.10.05.05.33.33;	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.01.56.50;	author mcalabre;	state Exp;
branches;
next	6.2.1.3;

6.2.1.3
date	2019.07.08.03.31.09;	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.01.04.50.51;	author mcalabre;	state Exp;
branches;
next	6.4.1.3;

6.4.1.3
date	2019.12.31.03.28.03;	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.3.1.1
date	2020.06.03.03.38.10;	author mcalabre;	state Exp;
branches;
next	7.3.1.2;

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

7.3.1.3
date	2021.01.19.14.09.10;	author mcalabre;	state Exp;
branches;
next	7.3.1.4;

7.3.1.4
date	2021.01.28.12.29.30;	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.5.1.2;

7.5.1.2
date	2021.04.13.09.21.51;	author mcalabre;	state Exp;
branches;
next	;

7.6.1.1
date	2021.04.13.13.00.35;	author mcalabre;	state Exp;
branches;
next	;

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

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

7.8.1.1
date	2022.03.25.06.14.14;	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.32;	author mcalabre;	state Exp;
branches;
next	7.11.1.2;

7.11.1.2
date	2022.09.04.07.16.21;	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.19;	author mcalabre;	state Exp;
branches;
next	;

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

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

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

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

8.2.1.3
date	2024.05.06.08.15.02;	author mcalabre;	state Exp;
branches;
next	8.2.1.4;

8.2.1.4
date	2024.05.07.12.48.09;	author mcalabre;	state Exp;
branches;
next	8.2.1.5;

8.2.1.5
date	2024.05.08.08.55.55;	author mcalabre;	state Exp;
branches;
next	8.2.1.6;

8.2.1.6
date	2024.05.08.15.15.24;	author mcalabre;	state Exp;
branches;
next	8.2.1.7;

8.2.1.7
date	2024.05.08.15.39.34;	author mcalabre;	state Exp;
branches;
next	8.2.1.8;

8.2.1.8
date	2024.05.10.14.35.39;	author mcalabre;	state Exp;
branches;
next	;

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

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

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

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

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

8.6.1.1
date	2026.03.29.14.19.26;	author mcalabre;	state Exp;
branches;
next	8.6.1.2;

8.6.1.2
date	2026.04.10.03.45.50;	author mcalabre;	state Exp;
branches;
next	8.6.1.3;

8.6.1.3
date	2026.04.13.03.32.35;	author mcalabre;	state Exp;
branches;
next	;


desc
@Driver routines for WCS spectral coordinate transformations.
@


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: spc.c,v 8.6.1.3 2026/04/13 03:32:35 mcalabre Exp mcalabre $
*===========================================================================*/

#include <math.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#include "wcserr.h"
#include "wcsmath.h"
#include "wcsprintf.h"
#include "wcstrig.h"
#include "wcsutil.h"
#include "spc.h"
#include "spx.h"

// Spectral algorithm codes.
#define F2S 100;		// Axis linear in frequency.
#define W2S 200;		// Axis linear in vacuum wavelengths.
#define A2S 300;		// Axis linear in air wavelengths.
#define V2S 400;		// Axis linear in velocity.
#define GRI 500;		// Grism in vacuum.
#define GRA 600;		// Grism in air.

// S-type spectral variables.
#define FREQ  0;		// Frequency-like.
#define AFRQ  1;		// Frequency-like.
#define ENER  2;		// Frequency-like.
#define WAVN  3;		// Frequency-like.
#define VRAD  4;		// Frequency-like.
#define WAVE 10;		// Vacuum wavelength-like.
#define VOPT 11;		// Vacuum wavelength-like.
#define ZOPT 12;		// Vacuum wavelength-like.
#define AWAV 20;		// Air wavelength-like.
#define VELO 30;		// Velocity-like.
#define BETA 31;		// Velocity-like.


// Map status return value to message.
const char *spc_errmsg[] = {
  "Success",
  "Null spcprm pointer passed",
  "Invalid spectral parameters",
  "One or more of x coordinates were invalid",
  "One or more of the spec coordinates were invalid"};

// Map error returns for lower-level routines.  SPXERR_BAD_INSPEC_COORD
// maps to either SPCERR_BAD_X or SPCERR_BAD_SPEC depending on context.
const int spc_spxerr[] = {
  SPCERR_SUCCESS,		//  0: SPXERR_SUCCESS
  SPCERR_NULL_POINTER,		//  1: SPXERR_NULL_POINTER
  SPCERR_BAD_SPEC_PARAMS,	//  2: SPXERR_BAD_SPEC_PARAMS
  SPCERR_BAD_SPEC_PARAMS	//  3: SPXERR_BAD_SPEC_VAR
				//  4: SPXERR_BAD_INSPEC_COORD
};

// Convenience macro for invoking wcserr_set().
#define SPC_ERRMSG(status) WCSERR_SET(status), spc_errmsg[status]


#define C 2.99792458e8

//----------------------------------------------------------------------------

int spcini(struct spcprm *spc)

{
  if (spc == 0x0) return SPCERR_NULL_POINTER;

  memset(spc->type, 0, 8);
  strncpy(spc->type, "    ", 8);
  strncpy(spc->code, "   ", 4);

  spc->crval = UNDEFINED;
  spc->restfrq =  0.0;
  spc->restwav =  0.0;

  for (int k = 0; k < 7; k++) {
    spc->pv[k] = UNDEFINED;
  }

  for (int k = 0; k < 6; k++) {
    spc->w[k] = 0.0;
  }

  spc->isGrism  = 0;
  spc->padding1 = 0;

  spc->err = 0x0;

  spc->padding2 = 0x0;
  spc->spxX2P = 0x0;
  spc->spxP2S = 0x0;
  spc->spxS2P = 0x0;
  spc->spxP2X = 0x0;

  spc->flag = 0;

  return 0;
}

//----------------------------------------------------------------------------

int spcfree(struct spcprm *spc)

{
  if (spc == 0x0) return SPCERR_NULL_POINTER;

  wcserr_clear(&(spc->err));

  return 0;
}

//----------------------------------------------------------------------------

int spcsize(const struct spcprm *spc, int sizes[2])

{
  if (spc == 0x0) {
    sizes[0] = sizes[1] = 0;
    return 0;
  }

  // Base size, in bytes.
  sizes[0] = sizeof(struct spcprm);

  // Total size of allocated memory, in bytes.
  sizes[1] = 0;

  // spcprm::err.
  int exsizes[2];
  wcserr_size(spc->err, exsizes);
  sizes[1] += exsizes[0] + exsizes[1];

  return 0;
}

//----------------------------------------------------------------------------

int spcenq(const struct spcprm *spc, int enquiry)

{
  // Initialize.
  if (spc == 0x0) return SPCERR_NULL_POINTER;

  int absflag = abs(spc->flag);
  int answer  = 0;

  if (enquiry & SPCENQ_SET) {
    if (absflag < 100 || 1000 < absflag) return 0;
    answer = 1;
  }

  if (enquiry & SPCENQ_BYP) {
    if (spc->flag != 1 && !(-1000 < spc->flag && spc->flag < -100)) return 0;
    answer = 1;
  }

  return answer;
}

//----------------------------------------------------------------------------

int spcprt(const struct spcprm *spc)

{
  if (spc == 0x0) return SPCERR_NULL_POINTER;

  // Parameters supplied.
  wcsprintf("       flag: %d\n", spc->flag);
  wcsprintf("       type: \"%s\"\n", spc->type);
  wcsprintf("       code: \"%s\"\n", spc->code);
  if (undefined(spc->crval)) {
    wcsprintf("      crval: UNDEFINED\n");
  } else {
    wcsprintf("      crval: %#- 11.5g\n", spc->crval);
  }
  wcsprintf("    restfrq: %f\n", spc->restfrq);
  wcsprintf("    restwav: %f\n", spc->restwav);

  wcsprintf("         pv:");
  if (spc->isGrism) {
    for (int i = 0; i < 5; i++) {
      if (undefined(spc->pv[i])) {
        wcsprintf("  UNDEFINED   ");
      } else {
        wcsprintf("  %#- 11.5g", spc->pv[i]);
      }
    }
    wcsprintf("\n            ");
    for (int i = 5; i < 7; i++) {
      if (undefined(spc->pv[i])) {
        wcsprintf("  UNDEFINED   ");
      } else {
        wcsprintf("  %#- 11.5g", spc->pv[i]);
      }
    }
    wcsprintf("\n");

  } else {
    wcsprintf(" (not used)\n");
  }

  // Derived values.
  wcsprintf("          w:");
  for (int i = 0; i < 3; i++) {
    wcsprintf("  %#- 11.5g", spc->w[i]);
  }
  if (spc->isGrism) {
    wcsprintf("\n            ");
    for (int i = 3; i < 6; i++) {
      wcsprintf("  %#- 11.5g", spc->w[i]);
    }
    wcsprintf("\n");
  } else {
    wcsprintf("  (remainder unused)\n");
  }

  wcsprintf("    isGrism: %d\n", spc->isGrism);

  // Error handling.
  WCSPRINTF_PTR("        err: ", spc->err, "\n");
  if (spc->err) {
    wcserr_prt(spc->err, "             ");
  }

  // Pointers to spectral functions.
  char hext[32];
  wcsprintf("     spxX2P: %s\n",
    wcsutil_fptr2str((void (*)(void))spc->spxX2P, hext));
  wcsprintf("     spxP2S: %s\n",
    wcsutil_fptr2str((void (*)(void))spc->spxP2S, hext));
  wcsprintf("     spxS2P: %s\n",
    wcsutil_fptr2str((void (*)(void))spc->spxS2P, hext));
  wcsprintf("     spxP2X: %s\n",
    wcsutil_fptr2str((void (*)(void))spc->spxP2X, hext));

  return 0;
}

//----------------------------------------------------------------------------

int spcperr(const struct spcprm *spc, const char *prefix)

{
  if (spc == 0x0) return SPCERR_NULL_POINTER;

  if (spc->err) {
    wcserr_prt(spc->err, prefix);
  }

  return 0;
}

//----------------------------------------------------------------------------

int spcset(struct spcprm *spc)

{
  static const char *function = "spcset";

  if (spc == 0x0) return SPCERR_NULL_POINTER;
  if (spc->flag < 0) return 0;
  struct wcserr **err = &(spc->err);

  if (undefined(spc->crval)) {
    return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
      "Spectral crval is undefined");
  }

  memset((spc->type)+4, 0, 4);
  spc->code[3] = '\0';
  wcsutil_blank_fill(4, spc->type);
  wcsutil_blank_fill(3, spc->code);
  spc->w[0] = 0.0;


  // Analyse the spectral axis type.
  char ctype[9];
  memset(ctype, 0, 9);
  memcpy(ctype, spc->type, 4);
  if (*(spc->code) != ' ') {
    snprintf(ctype+4, 5, "-%s", spc->code);
  }

  double restfrq = spc->restfrq;
  double restwav = spc->restwav;

  // The initialisations here are solely to appease clang-tidy.
  char   ptype = ' ', xtype = ' ';
  int    restreq = 0;
  double crvalX = 0.0, dXdS = 0.0;

  int status;
  if ((status = spcspxe(ctype, spc->crval, restfrq, restwav, &ptype, &xtype,
                        &restreq, &crvalX, &dXdS, &(spc->err)))) {
    return status;
  }

  // Satisfy rest frequency/wavelength requirements.
  if (restreq) {
    if (restreq == 3 && restfrq == 0.0 && restwav == 0.0) {
      // VRAD-V2F, VOPT-V2W, and ZOPT-V2W require the rest frequency or
      // wavelength for the S-P and P-X transformations but not for S-X
      // so supply a phoney value.
      restwav = 1.0;
    }

    if (restfrq == 0.0) {
      restfrq = C/restwav;
    } else {
      restwav = C/restfrq;
    }

    if (ptype == 'F') {
      spc->w[0] = restfrq;
    } else if (ptype != 'V') {
      spc->w[0] = restwav;
    } else {
      if (xtype == 'F') {
        spc->w[0] = restfrq;
      } else {
        spc->w[0] = restwav;
      }
    }
  }

  spc->w[1] = crvalX;
  spc->w[2] = dXdS;


  // Set pointers-to-functions for the linear part of the transformation.
  int flag = 0;
  if (ptype == 'F') {
    if (strcmp(spc->type, "FREQ") == 0) {
      // Frequency.
      flag = FREQ;
      spc->spxP2S = 0x0;
      spc->spxS2P = 0x0;

    } else if (strcmp(spc->type, "AFRQ") == 0) {
      // Angular frequency.
      flag = AFRQ;
      spc->spxP2S = freqafrq;
      spc->spxS2P = afrqfreq;

    } else if (strcmp(spc->type, "ENER") == 0) {
      // Photon energy.
      flag = ENER;
      spc->spxP2S = freqener;
      spc->spxS2P = enerfreq;

    } else if (strcmp(spc->type, "WAVN") == 0) {
      // Wave number.
      flag = WAVN;
      spc->spxP2S = freqwavn;
      spc->spxS2P = wavnfreq;

    } else if (strcmp(spc->type, "VRAD") == 0) {
      // Radio velocity.
      flag = VRAD;
      spc->spxP2S = freqvrad;
      spc->spxS2P = vradfreq;
    }

  } else if (ptype == 'W') {
    if (strcmp(spc->type, "WAVE") == 0) {
      // Vacuum wavelengths.
      flag = WAVE;
      spc->spxP2S = 0x0;
      spc->spxS2P = 0x0;

    } else if (strcmp(spc->type, "VOPT") == 0) {
      // Optical velocity.
      flag = VOPT;
      spc->spxP2S = wavevopt;
      spc->spxS2P = voptwave;

    } else if (strcmp(spc->type, "ZOPT") == 0) {
      // Redshift.
      flag = ZOPT;
      spc->spxP2S = wavezopt;
      spc->spxS2P = zoptwave;
    }

  } else if (ptype == 'A') {
    if (strcmp(spc->type, "AWAV") == 0) {
      // Air wavelengths.
      flag = AWAV;
      spc->spxP2S = 0x0;
      spc->spxS2P = 0x0;
    }

  } else if (ptype == 'V') {
    if (strcmp(spc->type, "VELO") == 0) {
      // Relativistic velocity.
      flag = VELO;
      spc->spxP2S = 0x0;
      spc->spxS2P = 0x0;

    } else if (strcmp(spc->type, "BETA") == 0) {
      // Velocity ratio (v/c).
      flag = BETA;
      spc->spxP2S = velobeta;
      spc->spxS2P = betavelo;
    }
  }


  // Set pointers-to-functions for the non-linear part of the spectral
  // transformation.
  spc->isGrism = 0;
  if (xtype == 'F') {
    // Axis is linear in frequency.
    if (ptype == 'F') {
      spc->spxX2P = 0x0;
      spc->spxP2X = 0x0;

    } else if (ptype == 'W') {
      spc->spxX2P = freqwave;
      spc->spxP2X = wavefreq;

    } else if (ptype == 'A') {
      spc->spxX2P = freqawav;
      spc->spxP2X = awavfreq;

    } else if (ptype == 'V') {
      spc->spxX2P = freqvelo;
      spc->spxP2X = velofreq;
    }

    flag += F2S;

  } else if (xtype == 'W' || xtype == 'w') {
    // Axis is linear in vacuum wavelengths.
    if (ptype == 'F') {
      spc->spxX2P = wavefreq;
      spc->spxP2X = freqwave;

    } else if (ptype == 'W') {
      spc->spxX2P = 0x0;
      spc->spxP2X = 0x0;

    } else if (ptype == 'A') {
      spc->spxX2P = waveawav;
      spc->spxP2X = awavwave;

    } else if (ptype == 'V') {
      spc->spxX2P = wavevelo;
      spc->spxP2X = velowave;
    }

    if (xtype == 'W') {
      flag += W2S;
    } else {
      // Grism in vacuum.
      spc->isGrism = 1;
      flag += GRI;
    }

  } else if (xtype == 'A' || xtype == 'a') {
    // Axis is linear in air wavelengths.
    if (ptype == 'F') {
      spc->spxX2P = awavfreq;
      spc->spxP2X = freqawav;

    } else if (ptype == 'W') {
      spc->spxX2P = awavwave;
      spc->spxP2X = waveawav;

    } else if (ptype == 'A') {
      spc->spxX2P = 0x0;
      spc->spxP2X = 0x0;

    } else if (ptype == 'V') {
      spc->spxX2P = awavvelo;
      spc->spxP2X = veloawav;
    }

    if (xtype == 'A') {
      flag += A2S;
    } else {
      // Grism in air.
      spc->isGrism = 2;
      flag += GRA;
    }

  } else if (xtype == 'V') {
    // Axis is linear in relativistic velocity.
    if (ptype == 'F') {
      spc->spxX2P = velofreq;
      spc->spxP2X = freqvelo;

    } else if (ptype == 'W') {
      spc->spxX2P = velowave;
      spc->spxP2X = wavevelo;

    } else if (ptype == 'A') {
      spc->spxX2P = veloawav;
      spc->spxP2X = awavvelo;

    } else if (ptype == 'V') {
      spc->spxX2P = 0x0;
      spc->spxP2X = 0x0;
    }

    flag += V2S;
  }


  // Check for grism axes.
  if (spc->isGrism) {
    // Axis is linear in "grism parameter"; work in wavelength.
    double lambda_r = crvalX;

    // Set defaults.
    if (undefined(spc->pv[0])) spc->pv[0] = 0.0;
    if (undefined(spc->pv[1])) spc->pv[1] = 0.0;
    if (undefined(spc->pv[2])) spc->pv[2] = 0.0;
    if (undefined(spc->pv[3])) spc->pv[3] = 1.0;
    if (undefined(spc->pv[4])) spc->pv[4] = 0.0;
    if (undefined(spc->pv[5])) spc->pv[5] = 0.0;
    if (undefined(spc->pv[6])) spc->pv[6] = 0.0;

    // Compute intermediaries.
    double G       = spc->pv[0];
    double m       = spc->pv[1];
    double alpha   = spc->pv[2];
    double n_r     = spc->pv[3];
    double dn_r    = spc->pv[4];
    double epsilon = spc->pv[5];
    double theta   = spc->pv[6];

    double t = G*m/cosd(epsilon);
    double beta_r = asind(t*lambda_r - n_r*sind(alpha));

    t -= dn_r*sind(alpha);

    spc->w[1] = -tand(theta);
    spc->w[2] *= t / (cosd(beta_r)*cosd(theta)*cosd(theta));
    spc->w[3] = beta_r + theta;
    spc->w[4] = (n_r - dn_r*lambda_r)*sind(alpha);
    spc->w[5] = 1.0 / t;
  }

  spc->flag = (spc->flag == 1) ? -flag : flag;

  return 0;
}

//----------------------------------------------------------------------------

int spcx2s(
  struct spcprm *spc,
  int nx,
  int sx,
  int sspec,
  const double x[],
  double spec[],
  int stat[])

{
  static const char *function = "spcx2s";

  // Initialize.
  if (spc == 0x0) return SPCERR_NULL_POINTER;
  struct wcserr **err = &(spc->err);

  int status = 0;
  if (abs(spc->flag) < 100) {
    if ((status = spcset(spc))) return status;
  }

  // Convert intermediate world coordinate x to X.
  const double *xp = x;
  double *specp = spec;
  int    *statp = stat;
  for (int ix = 0; ix < nx; ix++, xp += sx, specp += sspec, statp++) {
    *specp = spc->w[1] + (*xp)*spc->w[2];
    *statp = 0;
  }

  // If X is the grism parameter then convert it to wavelength.
  if (spc->isGrism) {
    specp = spec;
    for (int ix = 0; ix < nx; ix++, specp += sspec) {
      double beta = atand(*specp) + spc->w[3];
      *specp = (sind(beta) + spc->w[4]) * spc->w[5];
    }
  }

  // Apply the non-linear step of the algorithm chain to convert the
  // X-type spectral variable to P-type intermediate spectral variable.
  if (spc->spxX2P) {
    int statX2P;
    if ((statX2P = spc->spxX2P(spc->w[0], nx, sspec, sspec, spec, spec,
                               stat))) {
      if (statX2P == SPXERR_BAD_INSPEC_COORD) {
        status = SPCERR_BAD_X;
      } else if (statX2P == SPXERR_BAD_SPEC_PARAMS) {
        return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
          "Invalid spectral parameters: Frequency or wavelength is 0");
      } else {
        return wcserr_set(SPC_ERRMSG(spc_spxerr[statX2P]));
      }
    }
  }

  // Apply the linear step of the algorithm chain to convert P-type
  // intermediate spectral variable to the required S-type variable.
  if (spc->spxP2S) {
    int statP2S;
    if ((statP2S = spc->spxP2S(spc->w[0], nx, sspec, sspec, spec, spec,
                               stat))) {
      if (statP2S == SPXERR_BAD_INSPEC_COORD) {
        status = SPCERR_BAD_X;
      } else if (statP2S == SPXERR_BAD_SPEC_PARAMS) {
        return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
          "Invalid spectral parameters: Frequency or wavelength is 0");
      } else {
        return wcserr_set(SPC_ERRMSG(spc_spxerr[statP2S]));
      }
    }
  }

  if (status) {
    wcserr_set(SPC_ERRMSG(status));
  }
  return status;
}

//----------------------------------------------------------------------------

int spcs2x(
  struct spcprm *spc,
  int nspec,
  int sspec,
  int sx,
  const double spec[],
  double x[],
  int stat[])

{
  static const char *function = "spcs2x";

  // Initialize.
  if (spc == 0x0) return SPCERR_NULL_POINTER;
  struct wcserr **err = &(spc->err);

  int status = 0;
  if (abs(spc->flag) < 100) {
    if ((status = spcset(spc))) return status;
  }

  // Apply the linear step of the algorithm chain to convert the S-type
  // spectral variable to P-type intermediate spectral variable.
  if (spc->spxS2P) {
    int statS2P;
    if ((statS2P = spc->spxS2P(spc->w[0], nspec, sspec, sx, spec, x, stat))) {
      if (statS2P == SPXERR_BAD_INSPEC_COORD) {
        status = SPCERR_BAD_SPEC;
      } else if (statS2P == SPXERR_BAD_SPEC_PARAMS) {
        return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
          "Invalid spectral parameters: Frequency or wavelength is 0");
      } else {
        return wcserr_set(SPC_ERRMSG(spc_spxerr[statS2P]));
      }
    }

  } else {
    // Just a copy.
    double *xp = x;
    const double *specp = spec;
    int *statp = stat;
    for (int ispec = 0; ispec < nspec; ispec++, specp += sspec, xp += sx,
         statp++) {
      *xp = *specp;
      *statp = 0;
    }
  }


  // Apply the non-linear step of the algorithm chain to convert P-type
  // intermediate spectral variable to X-type spectral variable.
  if (spc->spxP2X) {
    int statP2X;
    if ((statP2X = spc->spxP2X(spc->w[0], nspec, sx, sx, x, x, stat))) {
      if (statP2X == SPCERR_BAD_SPEC) {
        status = SPCERR_BAD_SPEC;
      } else if (statP2X == SPXERR_BAD_SPEC_PARAMS) {
        return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
          "Invalid spectral parameters: Frequency or wavelength is 0");
      } else {
        return wcserr_set(SPC_ERRMSG(spc_spxerr[statP2X]));
      }
    }
  }

  if (spc->isGrism) {
    // Convert X-type spectral variable (wavelength) to grism parameter.
    double *xp = x;
    int *statp = stat;
    for (int ispec = 0; ispec < nspec; ispec++, xp += sx, statp++) {
      if (*statp) continue;

      double s = *xp/spc->w[5] - spc->w[4];
      if (fabs(s) <= 1.0) {
        double beta = asind(s);
        *xp = tand(beta - spc->w[3]);
      } else {
        *statp = 1;
      }
    }
  }


  // Convert X-type spectral variable to intermediate world coordinate x.
  double *xp = x;
  int *statp = stat;
  for (int ispec = 0; ispec < nspec; ispec++, xp += sx, statp++) {
    if (*statp) continue;

    *xp -= spc->w[1];
    *xp /= spc->w[2];
  }

  if (status) {
    wcserr_set(SPC_ERRMSG(status));
  }
  return status;
}

//----------------------------------------------------------------------------

int spctyp(
  const char ctypei[9],
  char stype[],
  char scode[],
  char sname[],
  char units[],
  char *ptype,
  char *xtype,
  int  *restreq)

{
  return spctype(
    ctypei, stype, scode, sname, units, ptype, xtype, restreq, NULL);
}

// : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : :

int spctype(
  const char ctypei[9],
  char stype[],
  char scode[],
  char sname[],
  char units[],
  char *ptype,
  char *xtype,
  int  *restreq,
  struct wcserr **err)

{
  static const char *function = "spctype";

  // Compiler balm for premature return on error.
  if (ptype)   *ptype = ' ';
  if (xtype)   *xtype = ' ';
  if (restreq) *restreq = 0;

  if (err) *err = 0x0;

  // Copy with blank padding.
  char ctype[9];
  snprintf(ctype, 9, "%-8.8s", ctypei);
  ctype[8] = '\0';

  char sname_t[32], units_t[8], ptype_t;
  int  restreq_t = 0;
  // Validate the S-type spectral variable.
  if (strncmp(ctype, "FREQ", 4) == 0) {
    strncpy(sname_t, "Frequency", 32);
    strncpy(units_t, "Hz", 8);
    ptype_t = 'F';
  } else if (strncmp(ctype, "AFRQ", 4) == 0) {
    strncpy(sname_t, "Angular frequency", 32);
    strncpy(units_t, "rad/s", 8);
    ptype_t = 'F';
  } else if (strncmp(ctype, "ENER", 4) == 0) {
    strncpy(sname_t, "Photon energy", 32);
    strncpy(units_t, "J", 8);
    ptype_t = 'F';
  } else if (strncmp(ctype, "WAVN", 4) == 0) {
    strncpy(sname_t, "Wavenumber", 32);
    strncpy(units_t, "/m", 8);
    ptype_t = 'F';
  } else if (strncmp(ctype, "VRAD", 4) == 0) {
    strncpy(sname_t, "Radio velocity", 32);
    strncpy(units_t, "m/s", 8);
    ptype_t = 'F';
    restreq_t = 1;
  } else if (strncmp(ctype, "WAVE", 4) == 0) {
    strncpy(sname_t, "Vacuum wavelength", 32);
    strncpy(units_t, "m", 8);
    ptype_t = 'W';
  } else if (strncmp(ctype, "VOPT", 4) == 0) {
    strncpy(sname_t, "Optical velocity", 32);
    strncpy(units_t, "m/s", 8);
    ptype_t = 'W';
    restreq_t = 1;
  } else if (strncmp(ctype, "ZOPT", 4) == 0) {
    strncpy(sname_t, "Redshift", 32);
    strncpy(units_t, "", 8);
    ptype_t = 'W';
    restreq_t = 1;
  } else if (strncmp(ctype, "AWAV", 4) == 0) {
    strncpy(sname_t, "Air wavelength", 32);
    strncpy(units_t, "m", 8);
    ptype_t = 'A';
  } else if (strncmp(ctype, "VELO", 4) == 0) {
    strncpy(sname_t, "Relativistic velocity", 32);
    strncpy(units_t, "m/s", 8);
    ptype_t = 'V';
  } else if (strncmp(ctype, "BETA", 4) == 0) {
    strncpy(sname_t, "Velocity ratio (v/c)", 32);
    strncpy(units_t, "", 8);
    ptype_t = 'V';
  } else {
    return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
      "Unknown spectral type '%s'", ctype);
  }


  // Determine X-type and validate the spectral algorithm code.
  char xtype_t;
  if ((xtype_t = ctype[5]) == ' ') {
    // The algorithm code must be completely blank.
    if (strcmp(ctype+4, "    ") != 0) {
      return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
        "Invalid spectral algorithm '%s'", ctype+4);
    }

    xtype_t = ptype_t;

  } else if (ctype[4] != '-') {
    return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
      "Invalid spectral type '%s'", ctype);

  } else if (strcmp(ctype+5, "LOG") == 0 || strcmp(ctype+5, "TAB") == 0) {
    // Logarithmic or tabular axis, not linear in any spectral type.

  } else if (xtype_t == 'G') {
    // Validate the algorithm code.
    if (ctype[6] != 'R') {
      return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
        "Invalid spectral algorithm '%s'", xtype_t);
    }

    // Grism coordinates...
    if (ctype[7] == 'I') {
      // ...in vacuum.
      xtype_t = 'w';
    } else if (ctype[7] == 'A') {
      // ...in air.
      xtype_t = 'a';
    } else {
      return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
        "Invalid spectral algorithm '%s'", xtype_t);
    }

  } else if (ctype[6] != '2') {
    // Algorithm code has invalid syntax.
    return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
      "Invalid spectral algorithm syntax '%s'", xtype_t);
  } else if (ctype[7] != ptype_t && ctype[7] != '?') {
    // The P-, and S-type variables are inconsistent.
    return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
      "In spectral type '%s', P- and S-type variables are inconsistent",
      ctype);

  } else if (ctype[7] == ctype[5]) {
    // Degenerate algorithm code.
    snprintf(ctype+4, 5, "    ");
  }


  // Rest freq/wavelength required for transformation between P and X?
  if (strchr("FWAwa", (int)xtype_t)) {
    if (ptype_t == 'V') {
      restreq_t += 2;
    }
  } else if (xtype_t == 'V') {
    if (strchr("FWAwa", (int)ptype_t)) {
      restreq_t += 2;
    }
  } else if (strchr("LT", (int)xtype_t) == 0) {
    // Invalid X-type variable code.
    return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
      "In spectral type '%s', invalid X-type variable code", ctype);
  }


  // Copy results.
  if (stype) {
    memcpy(stype, ctype, 4);
    stype[4] = '\0';
  }
  if (scode) strncpy(scode, ctype+5, 4);
  if (sname) strncpy(sname, sname_t, 22);
  if (units) strncpy(units, units_t, 8);
  if (ptype) *ptype = ptype_t;
  if (xtype) *xtype = xtype_t;
  if (restreq) *restreq = restreq_t;

  return 0;
}

//----------------------------------------------------------------------------

int spcspx(
  const char ctypeS[9],
  double crvalS,
  double restfrq,
  double restwav,
  char *ptype,
  char *xtype,
  int *restreq,
  double *crvalX,
  double *dXdS)

{
  return spcspxe(ctypeS, crvalS, restfrq, restwav, ptype, xtype, restreq,
                 crvalX, dXdS, 0x0);
}

// : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : :

int spcspxe(
  const char ctypeS[9],
  double crvalS,
  double restfrq,
  double restwav,
  char *ptype,
  char *xtype,
  int *restreq,
  double *crvalX,
  double *dXdS,
  struct wcserr **err)

{
  static const char *function = "spcspxe";

  // Analyse the spectral axis code.
  char stype[5], scode[4];
  int  status;
  if ((status = spctype(ctypeS, stype, scode, 0x0, 0x0, ptype, xtype, restreq,
                        err))) {
    return status;
  }

  if (strchr("LT", (int)(*xtype))) {
    // Can't handle logarithmic or tabular coordinates.
    return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
      "Can't handle logarithmic or tabular coordinates");
  }

  // Do we have rest frequency and/or wavelength as required?
  if ((*restreq)%3 && restfrq == 0.0 && restwav == 0.0) {
    return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
      "Missing required rest frequency or wavelength");
  }

  // Compute all spectral parameters and their derivatives.
  char type[8];
  strncpy(type, stype, 8);

  struct spxprm spx;
  spx.err = (err ? *err : 0x0);
  if ((status = specx(type, crvalS, restfrq, restwav, &spx))) {
    status = spc_spxerr[status];
    if (err) {
      if ((*err = spx.err)) {
        (*err)->status = status;
      }
    } else {
      wcserr_clear(&(spx.err));
    }
    return status;
  }


  // Transform S-P (linear) and P-X (non-linear).
  double dPdS = 0.0;
  double dXdP = 0.0;
  if (*ptype == 'F') {
    if (strcmp(stype, "FREQ") == 0) {
      dPdS = 1.0;
    } else if (strcmp(stype, "AFRQ") == 0) {
      dPdS = spx.dfreqafrq;
    } else if (strcmp(stype, "ENER") == 0) {
      dPdS = spx.dfreqener;
    } else if (strcmp(stype, "WAVN") == 0) {
      dPdS = spx.dfreqwavn;
    } else if (strcmp(stype, "VRAD") == 0) {
      dPdS = spx.dfreqvrad;
    }

    if (*xtype == 'F') {
      *crvalX = spx.freq;
      dXdP = 1.0;
    } else if (*xtype == 'W' || *xtype == 'w') {
      *crvalX = spx.wave;
      dXdP = spx.dwavefreq;
    } else if (*xtype == 'A' || *xtype == 'a') {
      *crvalX = spx.awav;
      dXdP = spx.dawavfreq;
    } else if (*xtype == 'V') {
      *crvalX = spx.velo;
      dXdP = spx.dvelofreq;
    }

  } else if (*ptype == 'W' || *ptype == 'w') {
    if (strcmp(stype, "WAVE") == 0) {
      dPdS = 1.0;
    } else if (strcmp(stype, "VOPT") == 0) {
      dPdS = spx.dwavevopt;
    } else if (strcmp(stype, "ZOPT") == 0) {
      dPdS = spx.dwavezopt;
    }

    if (*xtype == 'F') {
      *crvalX = spx.freq;
      dXdP = spx.dfreqwave;
    } else if (*xtype == 'W' || *xtype == 'w') {
      *crvalX = spx.wave;
      dXdP = 1.0;
    } else if (*xtype == 'A' || *xtype == 'a') {
      *crvalX = spx.awav;
      dXdP = spx.dawavwave;
    } else if (*xtype == 'V') {
      *crvalX = spx.velo;
      dXdP = spx.dvelowave;
    }

  } else if (*ptype == 'A' || *ptype == 'a') {
    if (strcmp(stype, "AWAV") == 0) {
      dPdS = 1.0;
    }

    if (*xtype == 'F') {
      *crvalX = spx.freq;
      dXdP = spx.dfreqawav;
    } else if (*xtype == 'W' || *xtype == 'w') {
      *crvalX = spx.wave;
      dXdP = spx.dwaveawav;
    } else if (*xtype == 'A' || *xtype == 'a') {
      *crvalX = spx.awav;
      dXdP = 1.0;
    } else if (*xtype == 'V') {
      *crvalX = spx.velo;
      dXdP = spx.dveloawav;
    }

  } else if (*ptype == 'V') {
    if (strcmp(stype, "VELO") == 0) {
      dPdS = 1.0;
    } else if (strcmp(stype, "BETA") == 0) {
      dPdS = spx.dvelobeta;
    }

    if (*xtype == 'F') {
      *crvalX = spx.freq;
      dXdP = spx.dfreqvelo;
    } else if (*xtype == 'W' || *xtype == 'w') {
      *crvalX = spx.wave;
      dXdP = spx.dwavevelo;
    } else if (*xtype == 'A' || *xtype == 'a') {
      *crvalX = spx.awav;
      dXdP = spx.dawavvelo;
    } else if (*xtype == 'V') {
      *crvalX = spx.velo;
      dXdP = 1.0;
    }
  }

  *dXdS = dXdP * dPdS;

  return 0;
}

//----------------------------------------------------------------------------

int spcxps(
  const char ctypeS[9],
  double crvalX,
  double restfrq,
  double restwav,
  char *ptype,
  char *xtype,
  int *restreq,
  double *crvalS,
  double *dSdX)

{
  return spcxpse(ctypeS, crvalX, restfrq, restwav, ptype, xtype, restreq,
                 crvalS, dSdX, NULL);
}

// : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : :

int spcxpse(
  const char ctypeS[9],
  double crvalX,
  double restfrq,
  double restwav,
  char *ptype,
  char *xtype,
  int *restreq,
  double *crvalS,
  double *dSdX,
  struct wcserr **err)

{
  static const char *function = "spcxpse";

  // Compiler balm for premature return on error.
  *crvalS  = 0.0;
  *dSdX    = 0.0;

  // Analyse the spectral axis type.
  char stype[5], scode[4];
  int status;
  if ((status = spctype(ctypeS, stype, scode, 0x0, 0x0, ptype, xtype, restreq,
                        err))) {
    return status;
  }

  if (strchr("LT", (int)(*xtype))) {
    // Can't handle logarithmic or tabular coordinates.
    return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
      "Can't handle logarithmic or tabular coordinates");
  }

  // Do we have rest frequency and/or wavelength as required?
  if ((*restreq)%3 && restfrq == 0.0 && restwav == 0.0) {
    return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
      "Missing required rest frequency or wavelength");
  }

  // Compute all spectral parameters and their derivatives.
  char type[8];
  if (*xtype == 'F') {
    strncpy(type, "FREQ", 8);
  } else if (*xtype == 'W' || *xtype == 'w') {
    strncpy(type, "WAVE", 8);
  } else if (*xtype == 'A' || *xtype == 'a') {
    strncpy(type, "AWAV", 8);
  } else if (*xtype == 'V') {
    strncpy(type, "VELO", 8);
  }

  struct spxprm spx;
  spx.err = (err ? *err : 0x0);
  if (specx(type, crvalX, restfrq, restwav, &spx)) {
    status = spc_spxerr[status];
    if (err) {
      if ((*err = spx.err)) {
        (*err)->status = status;
      }
    } else {
      wcserr_clear(&(spx.err));
    }
    return status;
  }


  // Transform X-P (non-linear) and P-S (linear).
  double dPdX = 0.0;
  double dSdP = 0.0;
  if (*ptype == 'F') {
    if (*xtype == 'F') {
      dPdX = 1.0;
    } else if (*xtype == 'W' || *xtype == 'w') {
      dPdX = spx.dfreqwave;
    } else if (*xtype == 'A' || *xtype == 'a') {
      dPdX = spx.dfreqawav;
    } else if (*xtype == 'V') {
      dPdX = spx.dfreqvelo;
    }

    if (strcmp(stype, "FREQ") == 0) {
      *crvalS = spx.freq;
      dSdP = 1.0;
    } else if (strcmp(stype, "AFRQ") == 0) {
      *crvalS = spx.afrq;
      dSdP = spx.dafrqfreq;
    } else if (strcmp(stype, "ENER") == 0) {
      *crvalS = spx.ener;
      dSdP = spx.denerfreq;
    } else if (strcmp(stype, "WAVN") == 0) {
      *crvalS = spx.wavn;
      dSdP = spx.dwavnfreq;
    } else if (strcmp(stype, "VRAD") == 0) {
      *crvalS = spx.vrad;
      dSdP = spx.dvradfreq;
    }

  } else if (*ptype == 'W') {
    if (*xtype == 'F') {
      dPdX = spx.dwavefreq;
    } else if (*xtype == 'W' || *xtype == 'w') {
      dPdX = 1.0;
    } else if (*xtype == 'A' || *xtype == 'a') {
      dPdX = spx.dwaveawav;
    } else if (*xtype == 'V') {
      dPdX = spx.dwavevelo;
    }

    if (strcmp(stype, "WAVE") == 0) {
      *crvalS = spx.wave;
      dSdP = 1.0;
    } else if (strcmp(stype, "VOPT") == 0) {
      *crvalS = spx.vopt;
      dSdP = spx.dvoptwave;
    } else if (strcmp(stype, "ZOPT") == 0) {
      *crvalS = spx.zopt;
      dSdP = spx.dzoptwave;
    }

  } else if (*ptype == 'A') {
    if (*xtype == 'F') {
      dPdX = spx.dawavfreq;
    } else if (*xtype == 'W' || *xtype == 'w') {
      dPdX = spx.dawavwave;
    } else if (*xtype == 'A' || *xtype == 'a') {
      dPdX = 1.0;
    } else if (*xtype == 'V') {
      dPdX = spx.dawavvelo;
    }

    if (strcmp(stype, "AWAV") == 0) {
      *crvalS = spx.awav;
      dSdP = 1.0;
    }

  } else if (*ptype == 'V') {
    if (*xtype == 'F') {
      dPdX = spx.dvelofreq;
    } else if (*xtype == 'W' || *xtype == 'w') {
      dPdX = spx.dvelowave;
    } else if (*xtype == 'A' || *xtype == 'a') {
      dPdX = spx.dveloawav;
    } else if (*xtype == 'V') {
      dPdX = 1.0;
    }

    if (strcmp(stype, "VELO") == 0) {
      *crvalS = spx.velo;
      dSdP = 1.0;
    } else if (strcmp(stype, "BETA") == 0) {
      *crvalS = spx.beta;
      dSdP = spx.dbetavelo;
    }
  }

  *dSdX = dSdP * dPdX;

  return 0;
}

//----------------------------------------------------------------------------

int spctrn(
  const char ctypeS1[9],
  double crvalS1,
  double cdeltS1,
  double restfrq,
  double restwav,
  char   ctypeS2[9],
  double *crvalS2,
  double *cdeltS2)

{
  return spctrne(ctypeS1, crvalS1, cdeltS1, restfrq, restwav,
                 ctypeS2, crvalS2, cdeltS2, NULL);
}

// : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : :

int spctrne(
  const char ctypeS1[9],
  double crvalS1,
  double cdeltS1,
  double restfrq,
  double restwav,
  char   ctypeS2[9],
  double *crvalS2,
  double *cdeltS2,
  struct wcserr **err)

{
  static const char *function = "spctrne";

  // Compiler balm for premature return on error.
  *crvalS2 = 0.0;
  *cdeltS2 = 0.0;

  if (restfrq == 0.0 && restwav == 0.0) {
    // If translating between two velocity-characteristic types, or between
    // two wave-characteristic types, then we may need to set a dummy rest
    // frequency or wavelength to perform the calculations.
    char stype1[5], stype2[5];
    strncpy(stype1, ctypeS1, 4);
    strncpy(stype2, ctypeS2, 4);
    stype1[4] = stype2[4] = '\0';
    if ((strstr("VRAD VOPT ZOPT VELO BETA", stype1) != 0x0) ==
        (strstr("VRAD VOPT ZOPT VELO BETA", stype2) != 0x0)) {
      restwav = 1.0;
    }
  }

  char   ptype1, xtype1;
  int    status, restreq;
  double crvalX, dXdS1;
  if ((status = spcspxe(ctypeS1, crvalS1, restfrq, restwav, &ptype1, &xtype1,
                        &restreq, &crvalX, &dXdS1, err))) {
    return status;
  }

  // Pad with blanks.
  char *cp;
  ctypeS2[8] = '\0';
  for (cp = ctypeS2; *cp; cp++);
  while (cp < ctypeS2+8) *(cp++) = ' ';

  if (strncmp(ctypeS2+5, "???", 3) == 0) {
    // Set the algorithm code if required.
    if (xtype1 == 'w') {
      strncpy(ctypeS2+5, "GRI", 4);
    } else if (xtype1 == 'a') {
      strncpy(ctypeS2+5, "GRA", 4);
    } else {
      ctypeS2[5] = xtype1;
      ctypeS2[6] = '2';
    }
  }

  char   ptype2, xtype2;
  double dS2dX;
  if ((status = spcxpse(ctypeS2, crvalX, restfrq, restwav, &ptype2, &xtype2,
                        &restreq, crvalS2, &dS2dX, err))) {
    return status;
  }

  // Are the X-types compatible?
  if (xtype2 != xtype1) {
    return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
      "Incompatible X-types '%c' and '%c'", xtype1, xtype2);
  }

  if (ctypeS2[7] == '?') {
    if (ptype2 == xtype2) {
      strncpy(ctypeS2+4, "    ", 5);
    } else {
      ctypeS2[7] = ptype2;
    }
  }

  *cdeltS2 = dS2dX * dXdS1 * cdeltS1;

  return 0;
}

//----------------------------------------------------------------------------

int spcaips(
  const char ctypeA[9],
  int  velref,
  char ctype[9],
  char specsys[9])

{
  const char *frames[] = {"LSRK", "BARYCENT", "TOPOCENT",
                          "LSRD", "GEOCENTR", "SOURCE", "GALACTOC"};

  // Make a null-filled copy of ctypeA.
  if (ctype != ctypeA) strncpy(ctype, ctypeA, 8);
  ctype[8] = '\0';
  wcsutil_null_fill(9, ctype);
  *specsys = '\0';

  // Is it a recognized AIPS-convention type?
  int status = SPCERR_NO_CHANGE;
  if (strncmp(ctype, "FREQ", 4) == 0 ||
      strncmp(ctype, "VELO", 4) == 0 ||
      strncmp(ctype, "FELO", 4) == 0) {
    // Look for the Doppler frame.
    char *fcode;
    if (*(fcode = ctype+4)) {
      if (strcmp(fcode, "-LSR") == 0) {
        strncpy(specsys, "LSRK", 9);
      } else if (strcmp(fcode, "-HEL") == 0) {
        strncpy(specsys, "BARYCENT", 9);
      } else if (strcmp(fcode, "-OBS") == 0) {
        strncpy(specsys, "TOPOCENT", 9);
      } else {
        // Not a recognized AIPS spectral type.
        return SPCERR_NO_CHANGE;
      }

      *fcode = '\0';
      status = 0;
    }

    // VELREF takes precedence if present.
    int ivf = velref%256;
    if (0 < ivf && ivf <= 7) {
      strncpy(specsys, frames[ivf-1], 9);
      status = 0;
    } else if (ivf) {
      status = SPCERR_BAD_SPEC_PARAMS;
    }

    if (strcmp(ctype, "VELO") == 0) {
      // Check that we found an AIPS-convention Doppler frame.
      if (*specsys) {
        // 'VELO' in AIPS means radio or optical depending on VELREF.
        ivf = velref/256;
        if (ivf == 0) {
          strncpy(ctype, "VOPT", 9);
        } else if (ivf == 1) {
          strncpy(ctype, "VRAD", 9);
        } else {
          status = SPCERR_BAD_SPEC_PARAMS;
        }
      }
    } else if (strcmp(ctype, "FELO") == 0) {
      // Uniform in frequency but expressed as an optical velocity (strictly
      // we should also have found an AIPS-convention Doppler frame).
      strncpy(ctype, "VOPT-F2W", 9);
      if (status < 0) status = 0;
    }
  }

  return status;
}
@


8.6
log
@WCSLIB 8.6
@
text
@d2 1
a2 1
  WCSLIB 8.6 - an implementation of the FITS WCS standard.
d22 1
a22 1
  $Id: spc.c,v 8.5.1.2 2026/03/29 13:36:16 mcalabre Exp mcalabre $
d92 2
a93 2
  strcpy(spc->type, "    ");
  strcpy(spc->code, "   ");
d304 1
a304 1
    sprintf(ctype+4, "-%s", spc->code);
d309 7
a315 3
  char   ptype, xtype;
  int    restreq, status;
  double crvalX, dXdS;
d796 1
a796 1
  sprintf(ctype, "%-8.8s", ctypei);
d803 2
a804 2
    strcpy(sname_t, "Frequency");
    strcpy(units_t, "Hz");
d807 2
a808 2
    strcpy(sname_t, "Angular frequency");
    strcpy(units_t, "rad/s");
d811 2
a812 2
    strcpy(sname_t, "Photon energy");
    strcpy(units_t, "J");
d815 2
a816 2
    strcpy(sname_t, "Wavenumber");
    strcpy(units_t, "/m");
d819 2
a820 2
    strcpy(sname_t, "Radio velocity");
    strcpy(units_t, "m/s");
d824 2
a825 2
    strcpy(sname_t, "Vacuum wavelength");
    strcpy(units_t, "m");
d828 2
a829 2
    strcpy(sname_t, "Optical velocity");
    strcpy(units_t, "m/s");
d833 2
a834 2
    strcpy(sname_t, "Redshift");
    strcpy(units_t, "");
d838 2
a839 2
    strcpy(sname_t, "Air wavelength");
    strcpy(units_t, "m");
d842 2
a843 2
    strcpy(sname_t, "Relativistic velocity");
    strcpy(units_t, "m/s");
d846 2
a847 2
    strcpy(sname_t, "Velocity ratio (v/c)");
    strcpy(units_t, "");
d904 1
a904 1
    sprintf(ctype+4, "    ");
d929 3
a931 3
  if (scode) strcpy(scode, ctype+5);
  if (sname) strcpy(sname, sname_t);
  if (units) strcpy(units, units_t);
d996 1
a996 1
  strcpy(type, stype);
d1174 1
a1174 1
    strcpy(type, "FREQ");
d1176 1
a1176 1
    strcpy(type, "WAVE");
d1178 1
a1178 1
    strcpy(type, "AWAV");
d1180 1
a1180 1
    strcpy(type, "VELO");
d1360 1
a1360 1
      strcpy(ctypeS2+5, "GRI");
d1362 1
a1362 1
      strcpy(ctypeS2+5, "GRA");
d1384 1
a1384 1
      strcpy(ctypeS2+4, "    ");
d1422 1
a1422 1
        strcpy(specsys, "LSRK");
d1424 1
a1424 1
        strcpy(specsys, "BARYCENT");
d1426 1
a1426 1
        strcpy(specsys, "TOPOCENT");
d1439 1
a1439 1
      strcpy(specsys, frames[ivf-1]);
d1451 1
a1451 1
          strcpy(ctype, "VOPT");
d1453 1
a1453 1
          strcpy(ctype, "VRAD");
d1461 1
a1461 1
      strcpy(ctype, "VOPT-F2W");
@


8.6.1.1
log
@WCSLIB 8.6 development branch.
@
text
@d22 1
a22 1
  $Id: spc.c,v 8.6 2026/03/29 13:53:56 mcalabre Exp $
@


8.6.1.2
log
@Inconsequential changes prompted by clang-tidy:
 - Replaced use of strcpy() with strncpy(), and sprintf() with snprintf()
   (clang-analyzer-security.insecureAPI.DeprecatedOrUnsafeBufferHandling).
@
text
@d22 1
a22 1
  $Id: spc.c,v 8.6.1.1 2026/03/29 14:19:26 mcalabre Exp mcalabre $
d92 2
a93 2
  strncpy(spc->type, "    ", 8);
  strncpy(spc->code, "   ", 4);
d304 1
a304 1
    snprintf(ctype+4, 5, "-%s", spc->code);
d792 1
a792 1
  snprintf(ctype, 9, "%-8.8s", ctypei);
d799 2
a800 2
    strncpy(sname_t, "Frequency", 32);
    strncpy(units_t, "Hz", 8);
d803 2
a804 2
    strncpy(sname_t, "Angular frequency", 32);
    strncpy(units_t, "rad/s", 8);
d807 2
a808 2
    strncpy(sname_t, "Photon energy", 32);
    strncpy(units_t, "J", 8);
d811 2
a812 2
    strncpy(sname_t, "Wavenumber", 32);
    strncpy(units_t, "/m", 8);
d815 2
a816 2
    strncpy(sname_t, "Radio velocity", 32);
    strncpy(units_t, "m/s", 8);
d820 2
a821 2
    strncpy(sname_t, "Vacuum wavelength", 32);
    strncpy(units_t, "m", 8);
d824 2
a825 2
    strncpy(sname_t, "Optical velocity", 32);
    strncpy(units_t, "m/s", 8);
d829 2
a830 2
    strncpy(sname_t, "Redshift", 32);
    strncpy(units_t, "", 8);
d834 2
a835 2
    strncpy(sname_t, "Air wavelength", 32);
    strncpy(units_t, "m", 8);
d838 2
a839 2
    strncpy(sname_t, "Relativistic velocity", 32);
    strncpy(units_t, "m/s", 8);
d842 2
a843 2
    strncpy(sname_t, "Velocity ratio (v/c)", 32);
    strncpy(units_t, "", 8);
d900 1
a900 1
    snprintf(ctype+4, 5, "    ");
d925 3
a927 3
  if (scode) strncpy(scode, ctype+5, 4);
  if (sname) strncpy(sname, sname_t, 22);
  if (units) strncpy(units, units_t, 8);
d992 1
a992 1
  strncpy(type, stype, 8);
d1170 1
a1170 1
    strncpy(type, "FREQ", 8);
d1172 1
a1172 1
    strncpy(type, "WAVE", 8);
d1174 1
a1174 1
    strncpy(type, "AWAV", 8);
d1176 1
a1176 1
    strncpy(type, "VELO", 8);
d1356 1
a1356 1
      strncpy(ctypeS2+5, "GRI", 4);
d1358 1
a1358 1
      strncpy(ctypeS2+5, "GRA", 4);
d1380 1
a1380 1
      strncpy(ctypeS2+4, "    ", 5);
d1418 1
a1418 1
        strncpy(specsys, "LSRK", 9);
d1420 1
a1420 1
        strncpy(specsys, "BARYCENT", 9);
d1422 1
a1422 1
        strncpy(specsys, "TOPOCENT", 9);
d1435 1
a1435 1
      strncpy(specsys, frames[ivf-1], 9);
d1447 1
a1447 1
          strncpy(ctype, "VOPT", 9);
d1449 1
a1449 1
          strncpy(ctype, "VRAD", 9);
d1457 1
a1457 1
      strncpy(ctype, "VOPT-F2W", 9);
@


8.6.1.3
log
@Further inconsequential changes prompted by clang-tidy:
 - In spcset(), initialise variables returned from spcspxe()
   (clang-analyzer-core.uninitialized.Assign).
@
text
@d22 1
a22 1
  $Id: spc.c,v 8.6.1.2 2026/04/10 03:45:50 mcalabre Exp mcalabre $
d309 3
a311 7

  // The initialisations here are solely to appease clang-tidy.
  char   ptype = ' ', xtype = ' ';
  int    restreq = 0;
  double crvalX = 0.0, dXdS = 0.0;

  int status;
@


8.5
log
@WCSLIB 8.5
@
text
@d2 2
a3 2
  WCSLIB 8.5 - an implementation of the FITS WCS standard.
  Copyright (C) 1995-2025, Mark Calabretta
d21 2
a22 2
  http://www.atnf.csiro.au/people/Mark.Calabretta
  $Id: spc.c,v 8.4.1.2 2025/12/06 13:37:16 mcalabre Exp mcalabre $
@


8.5.1.1
log
@WCSLIB 8.5 development branch.
@
text
@d22 1
a22 1
  $Id: spc.c,v 8.5 2025/12/06 13:47:41 mcalabre Exp $
@


8.5.1.2
log
@Updated date in copyright notice.
@
text
@d3 1
a3 1
  Copyright (C) 1995-2026, Mark Calabretta
d21 2
a22 2
  http://www.atnf.csiro.au/computing/software/wcs
  $Id: spc.c,v 8.5.1.1 2025/12/06 14:05:15 mcalabre Exp mcalabre $
@


8.4
log
@WCSLIB 8.4
@
text
@d2 2
a3 2
  WCSLIB 8.4 - an implementation of the FITS WCS standard.
  Copyright (C) 1995-2024, Mark Calabretta
d22 1
a22 1
  $Id: spc.c,v 8.3.1.1 2024/05/13 16:35:39 mcalabre Exp mcalabre $
@


8.4.1.1
log
@WCSLIB 8.4 development branch.
@
text
@d22 1
a22 1
  $Id: spc.c,v 8.4 2024/10/28 13:56:16 mcalabre Exp $
@


8.4.1.2
log
@Updated date in copyright notice.
@
text
@d3 1
a3 1
  Copyright (C) 1995-2025, Mark Calabretta
d22 1
a22 1
  $Id: spc.c,v 8.4.1.1 2024/10/28 13:58:41 mcalabre Exp mcalabre $
@


8.3
log
@WCSLIB 8.3
@
text
@d2 1
a2 1
  WCSLIB 8.3 - an implementation of the FITS WCS standard.
d22 1
a22 1
  $Id: spc.c,v 8.2.1.8 2024/05/10 14:35:39 mcalabre Exp mcalabre $
@


8.3.1.1
log
@WCSLIB 8.3 development branch.
@
text
@d22 1
a22 1
  $Id: spc.c,v 8.3 2024/05/13 16:33:00 mcalabre Exp $
@


8.2
log
@WCSLIB 8.2
@
text
@d2 2
a3 2
  WCSLIB 8.2 - an implementation of the FITS WCS standard.
  Copyright (C) 1995-2023, Mark Calabretta
d22 1
a22 1
  $Id: spc.c,v 8.1.1.1 2023/07/05 17:15:00 mcalabre Exp mcalabre $
a70 1

a88 2
  register int k;

a90 2
  spc->flag = 0;

d99 1
a99 1
  for (k = 0; k < 7; k++) {
d103 1
a103 1
  for (k = 0; k < 6; k++) {
d118 2
d142 1
a142 1
    return SPCERR_SUCCESS;
d151 1
a152 2

  // spcprm::err.
d156 25
a180 1
  return SPCERR_SUCCESS;
a187 3
  char hext[32];
  int  i;

d190 1
d204 1
a204 1
    for (i = 0; i < 5; i++) {
d212 1
a212 1
    for (i = 5; i < 7; i++) {
d225 1
d227 1
a227 1
  for (i = 0; i < 3; i++) {
d232 1
a232 1
    for (i = 3; i < 6; i++) {
d242 1
d248 2
a282 6
  char   ctype[9], ptype, xtype;
  int    restreq, status;
  double alpha, beta_r, crvalX, dn_r, dXdS, epsilon, G, m, lambda_r, n_r,
         t, restfrq, restwav, theta;
  struct wcserr **err;

d284 2
a285 1
  err = &(spc->err);
d300 1
d306 6
a311 2
  restfrq = spc->restfrq;
  restwav = spc->restwav;
d350 1
d354 1
a354 1
      spc->flag = FREQ;
d360 1
a360 1
      spc->flag = AFRQ;
d366 1
a366 1
      spc->flag = ENER;
d372 1
a372 1
      spc->flag = WAVN;
d378 1
a378 1
      spc->flag = VRAD;
d386 1
a386 1
      spc->flag = WAVE;
d392 1
a392 1
      spc->flag = VOPT;
d398 1
a398 1
      spc->flag = ZOPT;
d406 1
a406 1
      spc->flag = AWAV;
d414 1
a414 1
      spc->flag = VELO;
d420 1
a420 1
      spc->flag = BETA;
d449 1
a449 1
    spc->flag += F2S;
d471 1
a471 1
      spc->flag += W2S;
d475 1
a475 1
      spc->flag += GRI;
d498 1
a498 1
      spc->flag += A2S;
d502 1
a502 1
      spc->flag += GRA;
d524 1
a524 1
    spc->flag += V2S;
d531 1
a531 1
    lambda_r = crvalX;
d543 7
a549 7
    G       = spc->pv[0];
    m       = spc->pv[1];
    alpha   = spc->pv[2];
    n_r     = spc->pv[3];
    dn_r    = spc->pv[4];
    epsilon = spc->pv[5];
    theta   = spc->pv[6];
d551 2
a552 2
    t = G*m/cosd(epsilon);
    beta_r = asind(t*lambda_r - n_r*sind(alpha));
d563 2
a581 8
  int statP2S, status = 0, statX2P;
  double beta;
  register int ix;
  register int *statp;
  register const double *xp;
  register double *specp;
  struct wcserr **err;

d584 1
a584 1
  err = &(spc->err);
d586 2
a587 1
  if (spc->flag == 0) {
d592 4
a595 4
  xp = x;
  specp = spec;
  statp = stat;
  for (ix = 0; ix < nx; ix++, xp += sx, specp += sspec, statp++) {
d603 2
a604 2
    for (ix = 0; ix < nx; ix++, specp += sspec) {
      beta = atand(*specp) + spc->w[3];
d612 1
d629 1
a662 8
  int statP2X, status = 0, statS2P;
  double beta, s;
  register int ispec;
  register int *statp;
  register const double *specp;
  register double *xp;
  struct wcserr **err;

d665 1
a665 1
  err = &(spc->err);
d667 2
a668 1
  if (spc->flag == 0) {
d675 1
d689 5
a693 4
    xp = x;
    specp = spec;
    statp = stat;
    for (ispec = 0; ispec < nspec; ispec++, specp += sspec, xp += sx, statp++) {
d703 1
d718 3
a720 3
    xp = x;
    statp = stat;
    for (ispec = 0; ispec < nspec; ispec++, xp += sx, statp++) {
d723 1
a723 1
      s = *xp/spc->w[5] - spc->w[4];
d725 1
a725 1
        beta = asind(s);
d735 3
a737 3
  xp = x;
  statp = stat;
  for (ispec = 0; ispec < nspec; ispec++, xp += sx, statp++) {
d783 4
a786 2
  char ctype[9], ptype_t, sname_t[32], units_t[8], xtype_t;
  int  restreq_t = 0;
d791 1
d795 2
d852 1
a931 1

d970 2
a971 1
  char scode[4], stype[5], type[8];
a972 5
  double dPdS, dXdP;
  struct spxprm spx;


  // Analyse the spectral axis code.
d991 1
d993 2
d1010 2
a1011 2
  dPdS = 0.0;
  dXdP = 0.0;
d1143 3
a1145 4
  char scode[4], stype[5], type[8];
  int  status;
  double dPdX, dSdP;
  struct spxprm spx;
d1148 2
d1168 1
d1179 1
d1195 2
a1196 2
  dPdX = 0.0;
  dSdP = 0.0;
d1321 3
a1323 3
  char *cp, ptype1, ptype2, stype1[5], stype2[5], xtype1, xtype2;
  int  restreq, status;
  double crvalX, dS2dX, dXdS1;
d1329 1
d1339 3
d1348 1
d1365 2
a1401 2
  char *fcode;
  int  ivf, status;
d1410 1
a1410 1
  status = SPCERR_NO_CHANGE;
d1415 1
d1433 1
a1433 1
    ivf = velref%256;
@


8.2.1.1
log
@WCSLIB 8.2 development branch.
@
text
@d22 1
a22 1
  $Id: spc.c,v 8.2 2023/11/16 10:00:29 mcalabre Exp $
@


8.2.1.2
log
@Updated date in copyright notice.
@
text
@d3 1
a3 1
  Copyright (C) 1995-2024, Mark Calabretta
d22 1
a22 1
  $Id: spc.c,v 8.2.1.1 2023/11/16 10:05:57 mcalabre Exp mcalabre $
@


8.2.1.3
log
@In spctype(), spcxpse(), and spctrne(), initialise return values to keep the
compiler happy in case of premature return on error.
@
text
@d22 1
a22 1
  $Id: spc.c,v 8.2.1.2 2024/04/02 14:01:58 mcalabre Exp mcalabre $
a769 5
  // Compiler balm for premature return on error.
  if (ptype)   *ptype = ' ';
  if (xtype)   *xtype = ' ';
  if (restreq) *restreq = 0;

a1127 4
  // Compiler balm for premature return on error.
  *crvalS  = 0.0;
  *dSdX    = 0.0;

a1300 4

  // Compiler balm for premature return on error.
  *crvalS2 = 0.0;
  *cdeltS2 = 0.0;
@


8.2.1.4
log
@Converted to C99-style intermingled variable declarations.
@
text
@d22 1
a22 1
  $Id: spc.c,v 8.2.1.3 2024/05/06 08:15:02 mcalabre Exp mcalabre $
d90 2
d104 1
a104 1
  for (int k = 0; k < 7; k++) {
d108 1
a108 1
  for (int k = 0; k < 6; k++) {
d154 2
a156 1
  int exsizes[2];
d168 3
d186 1
a186 1
    for (int i = 0; i < 5; i++) {
d194 1
a194 1
    for (int i = 5; i < 7; i++) {
d208 1
a208 1
  for (int i = 0; i < 3; i++) {
d213 1
a213 1
    for (int i = 3; i < 6; i++) {
a227 1
  char hext[32];
d261 6
d268 1
a268 1
  struct wcserr **err = &(spc->err);
a282 1
  char ctype[9];
d288 2
a289 6

  double restfrq = spc->restfrq;
  double restwav = spc->restwav;
  char   ptype, xtype;
  int    restreq, status;
  double crvalX, dXdS;
d508 1
a508 1
    double lambda_r = crvalX;
d520 7
a526 7
    double G       = spc->pv[0];
    double m       = spc->pv[1];
    double alpha   = spc->pv[2];
    double n_r     = spc->pv[3];
    double dn_r    = spc->pv[4];
    double epsilon = spc->pv[5];
    double theta   = spc->pv[6];
d528 2
a529 2
    double t = G*m/cosd(epsilon);
    double beta_r = asind(t*lambda_r - n_r*sind(alpha));
d557 8
d567 1
a567 1
  struct wcserr **err = &(spc->err);
a568 1
  int status = 0;
d574 4
a577 4
  const double *xp = x;
  double *specp = spec;
  int    *statp = stat;
  for (int ix = 0; ix < nx; ix++, xp += sx, specp += sspec, statp++) {
d585 2
a586 2
    for (int ix = 0; ix < nx; ix++, specp += sspec) {
      double beta = atand(*specp) + spc->w[3];
a593 1
    int statX2P;
a609 1
    int statP2S;
d643 8
d653 1
a653 1
  struct wcserr **err = &(spc->err);
a654 1
  int status = 0;
a661 1
    int statS2P;
d675 4
a678 5
    double *xp = x;
    const double *specp = spec;
    int *statp = stat;
    for (int ispec = 0; ispec < nspec; ispec++, specp += sspec, xp += sx,
         statp++) {
a687 1
    int statP2X;
d702 3
a704 3
    double *xp = x;
    int *statp = stat;
    for (int ispec = 0; ispec < nspec; ispec++, xp += sx, statp++) {
d707 1
a707 1
      double s = *xp/spc->w[5] - spc->w[4];
d709 1
a709 1
        double beta = asind(s);
d719 3
a721 3
  double *xp = x;
  int *statp = stat;
  for (int ispec = 0; ispec < nspec; ispec++, xp += sx, statp++) {
d767 3
a777 1
  char ctype[9];
a780 2
  char sname_t[32], units_t[8], ptype_t;
  int  restreq_t = 0;
a835 1
  char xtype_t;
d954 6
a960 2
  char stype[5], scode[4];
  int  status;
a978 1
  char type[8];
a979 2

  struct spxprm spx;
d995 2
a996 2
  double dPdS = 0.0;
  double dXdP = 0.0;
d1128 5
a1137 2
  char stype[5], scode[4];
  int status;
a1155 1
  char type[8];
a1165 1
  struct spxprm spx;
d1181 2
a1182 2
  double dPdX = 0.0;
  double dSdP = 0.0;
d1307 4
a1318 1
    char stype1[5], stype2[5];
a1327 3
  char   ptype1, xtype1;
  int    status, restreq;
  double crvalX, dXdS1;
a1333 1
  char *cp;
a1349 2
  char   ptype2, xtype2;
  double dS2dX;
d1385 2
d1395 1
a1395 1
  int status = SPCERR_NO_CHANGE;
a1399 1
    char *fcode;
d1417 1
a1417 1
    int ivf = velref%256;
@


8.2.1.5
log
@Changes required to support bypass mode in spcset().
@
text
@d22 1
a22 1
  $Id: spc.c,v 8.2.1.4 2024/05/07 12:48:09 mcalabre Exp mcalabre $
d71 1
d92 2
a120 2
  spc->flag = 0;

d143 1
a143 1
    return 0;
d157 1
a157 1
  return 0;
a166 1
  // Parameters supplied.
a200 1
  // Derived values.
a216 1
  // Error handling.
a221 1
  // Pointers to spectral functions.
a256 1
  if (spc->flag < 0) return 0;
a321 1
  int flag = 0;
d325 1
a325 1
      flag = FREQ;
d331 1
a331 1
      flag = AFRQ;
d337 1
a337 1
      flag = ENER;
d343 1
a343 1
      flag = WAVN;
d349 1
a349 1
      flag = VRAD;
d357 1
a357 1
      flag = WAVE;
d363 1
a363 1
      flag = VOPT;
d369 1
a369 1
      flag = ZOPT;
d377 1
a377 1
      flag = AWAV;
d385 1
a385 1
      flag = VELO;
d391 1
a391 1
      flag = BETA;
d420 1
a420 1
    flag += F2S;
d442 1
a442 1
      flag += W2S;
d446 1
a446 1
      flag += GRI;
d469 1
a469 1
      flag += A2S;
d473 1
a473 1
      flag += GRA;
d495 1
a495 1
    flag += V2S;
a533 2
  spc->flag = (spc->flag == 1) ? -flag : flag;

d556 1
a556 1
  if (abs(spc->flag) < 100) {
d637 1
a637 1
  if (abs(spc->flag) < 100) {
d900 1
@


8.2.1.6
log
@Added spcenq().
@
text
@d22 1
a22 1
  $Id: spc.c,v 8.2.1.5 2024/05/08 08:55:55 mcalabre Exp mcalabre $
a156 26
}

//----------------------------------------------------------------------------

int spcenq(const struct spcprm *spc, int enquiry)

{
  static const char *function = "spcenq";

  // Initialize.
  if (spc == 0x0) return SPCERR_NULL_POINTER;

  int absflag = abs(spc->flag);
  int answer  = 0;

  if (enquiry & SPCENQ_SET) {
    if (absflag < 100 || 1000 < absflag) return 0;
    answer = 1;
  }

  if (enquiry & SPCENQ_BYP) {
    if (0 < spc->flag || absflag < 100 || 1000 < absflag) return 0;
    answer = 1;
  }

  return answer;
@


8.2.1.7
log
@Attended to compiler warnings about unused variables.
@
text
@d22 1
a22 1
  $Id: spc.c,v 8.2.1.6 2024/05/08 15:15:24 mcalabre Exp mcalabre $
d164 2
@


8.2.1.8
log
@In spcenq(), fixed the test for bypass mode.  The spcprm struct is also in
bypass mode, though unset, if disprm::flag == 1.
@
text
@d22 1
a22 1
  $Id: spc.c,v 8.2.1.7 2024/05/08 15:39:34 mcalabre Exp mcalabre $
d176 1
a176 1
    if (spc->flag != 1 && !(-1000 < spc->flag && spc->flag < -100)) return 0;
@


8.1
log
@WCSLIB 8.1
@
text
@d2 1
a2 1
  WCSLIB 8.1 - an implementation of the FITS WCS standard.
d22 1
a22 1
  $Id: spc.c,v 8.0.1.1 2023/07/01 06:22:44 mcalabre Exp mcalabre $
@


8.1.1.1
log
@WCSLIB 8.1 development branch.
@
text
@d22 1
a22 1
  $Id: spc.c,v 8.1 2023/07/05 17:12:07 mcalabre Exp $
@


8.0
log
@WCSLIB 8.0
@
text
@d2 1
a2 1
  WCSLIB 8.0 - an implementation of the FITS WCS standard.
d22 1
a22 1
  $Id: spc.c,v 7.13.1.2 2023/06/15 04:17:19 mcalabre Exp mcalabre $
@


8.0.1.1
log
@WCSLIB 8.0 development branch.
@
text
@d22 1
a22 1
  $Id: spc.c,v 8.0 2023/07/01 06:15:04 mcalabre Exp $
@


7.13
log
@WCSLIB 7.13
@
text
@d2 2
a3 2
  WCSLIB 7.13 - an implementation of the FITS WCS standard.
  Copyright (C) 1995-2022, Mark Calabretta
d22 1
a22 1
  $Id: spc.c,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
@d22 1
a22 1
  $Id: spc.c,v 7.13 2022/10/07 03:43:35 mcalabre Exp $
@


7.13.1.2
log
@Updated date in copyright notice.
@
text
@d3 1
a3 1
  Copyright (C) 1995-2023, Mark Calabretta
d22 1
a22 1
  $Id: spc.c,v 7.13.1.1 2022/10/07 03:45:47 mcalabre Exp mcalabre $
@


7.12
log
@WCSLIB 7.12
@
text
@d2 1
a2 1
  WCSLIB 7.12 - an implementation of the FITS WCS standard.
d22 1
a22 1
  $Id: spc.c,v 7.11.1.2 2022/09/04 07:16:21 mcalabre Exp mcalabre $
@


7.12.1.1
log
@WCSLIB 7.12 development branch.
@
text
@d22 1
a22 1
  $Id: spc.c,v 7.12 2022/09/09 04:57:58 mcalabre Exp $
@


7.11
log
@WCSLIB 7.11
@
text
@d2 1
a2 1
  WCSLIB 7.11 - an implementation of the FITS WCS standard.
d22 1
a22 1
  $Id: spc.c,v 7.10.1.1 2022/04/23 14:26:54 mcalabre Exp mcalabre $
d577 1
a577 1
  for (ix = 0; ix < nx; ix++, xp += sx, specp += sspec) {
d579 1
a579 1
    *(statp++) = 0;
d678 1
a678 1
    for (ispec = 0; ispec < nspec; ispec++, specp += sspec, xp += sx) {
d680 1
a680 1
      *(statp++) = 0;
d721 2
a722 2
  for (ispec = 0; ispec < nspec; ispec++, xp += sx) {
    if (*(statp++)) continue;
@


7.11.1.1
log
@WCSLIB 7.11 development branch.
@
text
@d22 1
a22 1
  $Id: spc.c,v 7.11 2022/04/26 06:13:52 mcalabre Exp $
@


7.11.1.2
log
@Increment the statp pointer within the for loop control statement as it
seems simpler and more consistent with the way the other pointers are
incremented.
@
text
@d22 1
a22 1
  $Id: spc.c,v 7.11.1.1 2022/04/26 06:15:32 mcalabre Exp mcalabre $
d577 1
a577 1
  for (ix = 0; ix < nx; ix++, xp += sx, specp += sspec, statp++) {
d579 1
a579 1
    *statp = 0;
d678 1
a678 1
    for (ispec = 0; ispec < nspec; ispec++, specp += sspec, xp += sx, statp++) {
d680 1
a680 1
      *statp = 0;
d721 2
a722 2
  for (ispec = 0; ispec < nspec; ispec++, xp += sx, statp++) {
    if (*statp) continue;
@


7.10
log
@WCSLIB 7.10
@
text
@d2 1
a2 1
  WCSLIB 7.10 - an implementation of the FITS WCS standard.
d22 1
a22 1
  $Id: spc.c,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
@d22 1
a22 1
  $Id: spc.c,v 7.10 2022/04/23 14:25:15 mcalabre Exp $
@


7.9
log
@WCSLIB 7.9
@
text
@d2 1
a2 1
  WCSLIB 7.9 - an implementation of the FITS WCS standard.
d22 1
a22 1
  $Id: spc.c,v 7.8.1.1 2022/03/25 06:14:14 mcalabre Exp mcalabre $
@


7.9.1.1
log
@WCSLIB 7.9 development branch.
@
text
@d22 1
a22 1
  $Id: spc.c,v 7.9 2022/03/25 15:14:48 mcalabre Exp $
@


7.8
log
@WCSLIB 7.8
@
text
@d2 1
a2 1
  WCSLIB 7.8 - an implementation of the FITS WCS standard.
d22 1
a22 1
  $Id: spc.c,v 7.7.1.2 2022/03/25 06:05:59 mcalabre Exp mcalabre $
@


7.8.1.1
log
@WCSLIB 7.8 development branch.
@
text
@d22 1
a22 1
  $Id: spc.c,v 7.8 2022/03/25 06:11:49 mcalabre Exp $
@


7.7
log
@WCSLIB 7.7
@
text
@d2 2
a3 2
  WCSLIB 7.7 - an implementation of the FITS WCS standard.
  Copyright (C) 1995-2021, Mark Calabretta
d22 1
a22 1
  $Id: spc.c,v 7.6.1.1 2021/04/13 13:00:35 mcalabre Exp mcalabre $
@


7.7.1.1
log
@WCSLIB 7.7 development branch.
@
text
@d22 1
a22 1
  $Id: spc.c,v 7.7 2021/07/12 06:36:49 mcalabre Exp $
@


7.7.1.2
log
@Updated date in copyright notice.
@
text
@d3 1
a3 1
  Copyright (C) 1995-2022, Mark Calabretta
d22 1
a22 1
  $Id: spc.c,v 7.7.1.1 2021/07/12 06:38:27 mcalabre Exp mcalabre $
@


7.6
log
@WCSLIB 7.6
@
text
@d2 1
a2 1
  WCSLIB 7.6 - an implementation of the FITS WCS standard.
d22 1
a22 1
  $Id: spc.c,v 7.5.1.2 2021/04/13 09:21:51 mcalabre Exp mcalabre $
@


7.6.1.1
log
@WCSLIB 7.6 development branch.
@
text
@d22 1
a22 1
  $Id: spc.c,v 7.6 2021/04/13 12:57:01 mcalabre Exp $
@


7.5
log
@WCSLIB 7.5
@
text
@d2 1
a2 1
  WCSLIB 7.5 - an implementation of the FITS WCS standard.
d22 1
a22 1
  $Id: spc.c,v 7.4.1.1 2021/01/31 02:26:24 mcalabre Exp mcalabre $
d136 25
@


7.5.1.1
log
@WCSLIB 7.5 development branch.
@
text
@d22 1
a22 1
  $Id: spc.c,v 7.5 2021/03/20 05:54:58 mcalabre Exp $
@


7.5.1.2
log
@Added new function spcsize().
@
text
@d22 1
a22 1
  $Id: spc.c,v 7.5.1.1 2021/03/20 05:56:42 mcalabre Exp mcalabre $
a135 25
}

//----------------------------------------------------------------------------

int spcsize(const struct spcprm *spc, int sizes[2])

{
  if (spc == 0x0) {
    sizes[0] = sizes[1] = 0;
    return SPCERR_SUCCESS;
  }

  // Base size, in bytes.
  sizes[0] = sizeof(struct spcprm);

  // Total size of allocated memory, in bytes.
  sizes[1] = 0;

  int exsizes[2];

  // spcprm::err.
  wcserr_size(spc->err, exsizes);
  sizes[1] += exsizes[0] + exsizes[1];

  return SPCERR_SUCCESS;
@


7.4
log
@WCSLIB 7.4
@
text
@d2 1
a2 1
  WCSLIB 7.4 - an implementation of the FITS WCS standard.
d22 1
a22 1
  $Id: spc.c,v 7.3.1.4 2021/01/28 12:29:30 mcalabre Exp mcalabre $
@


7.4.1.1
log
@WCSLIB 7.4 development branch.
@
text
@d22 1
a22 1
  $Id: spc.c,v 7.4 2021/01/31 02:24:51 mcalabre Exp $
@


7.3
log
@WCSLIB 7.3
@
text
@d2 2
a3 3

  WCSLIB 7.3 - an implementation of the FITS WCS standard.
  Copyright (C) 1995-2020, Mark Calabretta
a19 2
  Direct correspondence concerning WCSLIB to mark@@calabretta.id.au

d22 1
a22 1
  $Id: spc.c,v 7.2.1.1 2020/03/09 07:34:50 mcalabre Exp mcalabre $
d38 20
a57 20
/* Spectral algorithm codes. */
#define F2S 100;		/* Axis linear in frequency.          */
#define W2S 200;		/* Axis linear in vacuum wavelengths. */
#define A2S 300;		/* Axis linear in air wavelengths.    */
#define V2S 400;		/* Axis linear in velocity.           */
#define GRI 500;		/* Grism in vacuum.                   */
#define GRA 600;		/* Grism in air.                      */

/* S-type spectral variables. */
#define FREQ  0;		/* Frequency-like.                    */
#define AFRQ  1;		/* Frequency-like.                    */
#define ENER  2;		/* Frequency-like.                    */
#define WAVN  3;		/* Frequency-like.                    */
#define VRAD  4;		/* Frequency-like.                    */
#define WAVE 10;		/* Vacuum wavelength-like.            */
#define VOPT 11;		/* Vacuum wavelength-like.            */
#define ZOPT 12;		/* Vacuum wavelength-like.            */
#define AWAV 20;		/* Air wavelength-like.               */
#define VELO 30;		/* Velocity-like.                     */
#define BETA 31;		/* Velocity-like.                     */
d60 1
a60 1
/* Map status return value to message. */
d68 2
a69 2
/* Map error returns for lower-level routines.  SPXERR_BAD_INSPEC_COORD */
/* maps to either SPCERR_BAD_X or SPCERR_BAD_SPEC depending on context. */
d72 5
a76 5
  SPCERR_SUCCESS,		/*  0: SPXERR_SUCCESS          */
  SPCERR_NULL_POINTER,		/*  1: SPXERR_NULL_POINTER     */
  SPCERR_BAD_SPEC_PARAMS,	/*  2: SPXERR_BAD_SPEC_PARAMS  */
  SPCERR_BAD_SPEC_PARAMS	/*  3: SPXERR_BAD_SPEC_VAR     */
				/*  4: SPXERR_BAD_INSPEC_COORD */
d79 1
a79 1
/* Convenience macro for invoking wcserr_set(). */
d85 1
a85 1
/*--------------------------------------------------------------------------*/
d126 1
a126 1
/*--------------------------------------------------------------------------*/
d138 1
a138 1
/*--------------------------------------------------------------------------*/
d215 1
a215 1
/*--------------------------------------------------------------------------*/
d229 1
a229 1
/*--------------------------------------------------------------------------*/
d257 1
a257 1
  /* Analyse the spectral axis type. */
d270 1
a270 1
  /* Satisfy rest frequency/wavelength requirements. */
d273 3
a275 3
      /* VRAD-V2F, VOPT-V2W, and ZOPT-V2W require the rest frequency or */
      /* wavelength for the S-P and P-X transformations but not for S-X */
      /* so supply a phoney value. */
d302 1
a302 1
  /* Set pointers-to-functions for the linear part of the transformation. */
d305 1
a305 1
      /* Frequency. */
d311 1
a311 1
      /* Angular frequency. */
d317 1
a317 1
      /* Photon energy. */
d323 1
a323 1
      /* Wave number. */
d329 1
a329 1
      /* Radio velocity. */
d337 1
a337 1
      /* Vacuum wavelengths. */
d343 1
a343 1
      /* Optical velocity. */
d349 1
a349 1
      /* Redshift. */
d357 1
a357 1
      /* Air wavelengths. */
d365 1
a365 1
      /* Relativistic velocity. */
d371 1
a371 1
      /* Velocity ratio (v/c). */
d379 2
a380 2
  /* Set pointers-to-functions for the non-linear part of the spectral */
  /* transformation.                                                   */
d383 1
a383 1
    /* Axis is linear in frequency. */
d404 1
a404 1
    /* Axis is linear in vacuum wavelengths. */
d425 1
a425 1
      /* Grism in vacuum. */
d431 1
a431 1
    /* Axis is linear in air wavelengths. */
d452 1
a452 1
      /* Grism in air. */
d458 1
a458 1
    /* Axis is linear in relativistic velocity. */
d480 1
a480 1
  /* Check for grism axes. */
d482 1
a482 1
    /* Axis is linear in "grism parameter"; work in wavelength. */
d485 1
a485 1
    /* Set defaults. */
d494 1
a494 1
    /* Compute intermediaries. */
d518 1
a518 1
/*--------------------------------------------------------------------------*/
d540 1
a540 1
  /* Initialize. */
d548 1
a548 1
  /* Convert intermediate world coordinate x to X. */
d557 1
a557 1
  /* If X is the grism parameter then convert it to wavelength. */
d566 2
a567 2
  /* Apply the non-linear step of the algorithm chain to convert the    */
  /* X-type spectral variable to P-type intermediate spectral variable. */
d582 2
a583 2
  /* Apply the linear step of the algorithm chain to convert P-type  */
  /* intermediate spectral variable to the required S-type variable. */
d604 1
a604 1
/*--------------------------------------------------------------------------*/
d626 1
a626 1
  /* Initialize. */
d634 2
a635 2
  /* Apply the linear step of the algorithm chain to convert the S-type */
  /* spectral variable to P-type intermediate spectral variable.        */
d649 1
a649 1
    /* Just a copy. */
d660 2
a661 2
  /* Apply the non-linear step of the algorithm chain to convert P-type */
  /* intermediate spectral variable to X-type spectral variable. */
d676 1
a676 1
    /* Convert X-type spectral variable (wavelength) to grism parameter. */
d693 1
a693 1
  /* Convert X-type spectral variable to intermediate world coordinate x. */
d709 1
a709 1
/*--------------------------------------------------------------------------*/
d726 1
a726 1
/* : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : :  */
d747 1
a747 1
  /* Copy with blank padding. */
d751 1
a751 1
  /* Validate the S-type spectral variable. */
d805 1
a805 1
  /* Determine X-type and validate the spectral algorithm code. */
d807 1
a807 1
    /* The algorithm code must be completely blank. */
d820 1
a820 1
    /* Logarithmic or tabular axis, not linear in any spectral type. */
d823 1
a823 1
    /* Validate the algorithm code. */
d829 1
a829 1
    /* Grism coordinates... */
d831 1
a831 1
      /* ...in vacuum. */
d834 1
a834 1
      /* ...in air. */
d842 1
a842 1
    /* Algorithm code has invalid syntax. */
d846 1
a846 1
    /* The P-, and S-type variables are inconsistent. */
d852 1
a852 1
    /* Degenerate algorithm code. */
d857 1
a857 1
  /* Rest freq/wavelength required for transformation between P and X? */
d867 1
a867 1
    /* Invalid X-type variable code. */
d873 1
a873 1
  /* Copy results. */
d889 1
a889 1
/*--------------------------------------------------------------------------*/
d907 1
a907 1
/* : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : :  */
d930 1
a930 1
  /* Analyse the spectral axis code. */
d937 1
a937 1
    /* Can't handle logarithmic or tabular coordinates. */
d942 1
a942 1
  /* Do we have rest frequency and/or wavelength as required? */
d948 1
a948 1
  /* Compute all spectral parameters and their derivatives. */
d964 1
a964 1
  /* Transform S-P (linear) and P-X (non-linear). */
d1063 1
a1063 1
/*--------------------------------------------------------------------------*/
d1081 1
a1081 1
/* : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : :  */
d1103 1
a1103 1
  /* Analyse the spectral axis type. */
d1110 1
a1110 1
    /* Can't handle logarithmic or tabular coordinates. */
d1115 1
a1115 1
  /* Do we have rest frequency and/or wavelength as required? */
d1121 1
a1121 1
  /* Compute all spectral parameters and their derivatives. */
d1146 1
a1146 1
  /* Transform X-P (non-linear) and P-S (linear). */
d1240 1
a1240 1
/*--------------------------------------------------------------------------*/
d1257 1
a1257 1
/* : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : :  */
d1278 3
a1280 3
    /* If translating between two velocity-characteristic types, or between
       two wave-characteristic types, then we may need to set a dummy rest
       frequency or wavelength to perform the calculations. */
d1295 1
a1295 1
  /* Pad with blanks. */
d1301 1
a1301 1
    /* Set the algorithm code if required. */
d1317 1
a1317 1
  /* Are the X-types compatible? */
d1336 1
a1336 1
/*--------------------------------------------------------------------------*/
d1350 1
a1350 1
  /* Make a null-filled copy of ctypeA. */
d1356 1
a1356 1
  /* Is it a recognized AIPS-convention type? */
d1361 1
a1361 1
    /* Look for the Doppler frame. */
d1370 1
a1370 1
        /* Not a recognized AIPS spectral type. */
d1378 1
a1378 1
    /* VELREF takes precedence if present. */
d1388 1
a1388 1
      /* Check that we found an AIPS-convention Doppler frame. */
d1390 1
a1390 1
        /* 'VELO' in AIPS means radio or optical depending on VELREF. */
d1401 2
a1402 2
      /* Uniform in frequency but expressed as an optical velocity (strictly
         we should also have found an AIPS-convention Doppler frame). */
@


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


7.3.1.2
log
@Switched to C99 style commenting (i.e. using //) within the code.
@
text
@d2 1
d25 1
a25 1
  $Id: spc.c,v 7.3.1.1 2020/06/03 03:38:10 mcalabre Exp mcalabre $
d41 20
a60 20
// Spectral algorithm codes.
#define F2S 100;		// Axis linear in frequency.
#define W2S 200;		// Axis linear in vacuum wavelengths.
#define A2S 300;		// Axis linear in air wavelengths.
#define V2S 400;		// Axis linear in velocity.
#define GRI 500;		// Grism in vacuum.
#define GRA 600;		// Grism in air.

// S-type spectral variables.
#define FREQ  0;		// Frequency-like.
#define AFRQ  1;		// Frequency-like.
#define ENER  2;		// Frequency-like.
#define WAVN  3;		// Frequency-like.
#define VRAD  4;		// Frequency-like.
#define WAVE 10;		// Vacuum wavelength-like.
#define VOPT 11;		// Vacuum wavelength-like.
#define ZOPT 12;		// Vacuum wavelength-like.
#define AWAV 20;		// Air wavelength-like.
#define VELO 30;		// Velocity-like.
#define BETA 31;		// Velocity-like.
d63 1
a63 1
// Map status return value to message.
d71 2
a72 2
// Map error returns for lower-level routines.  SPXERR_BAD_INSPEC_COORD
// maps to either SPCERR_BAD_X or SPCERR_BAD_SPEC depending on context.
d75 5
a79 5
  SPCERR_SUCCESS,		//  0: SPXERR_SUCCESS
  SPCERR_NULL_POINTER,		//  1: SPXERR_NULL_POINTER
  SPCERR_BAD_SPEC_PARAMS,	//  2: SPXERR_BAD_SPEC_PARAMS
  SPCERR_BAD_SPEC_PARAMS	//  3: SPXERR_BAD_SPEC_VAR
				//  4: SPXERR_BAD_INSPEC_COORD
d82 1
a82 1
// Convenience macro for invoking wcserr_set().
d88 1
a88 1
//----------------------------------------------------------------------------
d129 1
a129 1
//----------------------------------------------------------------------------
d141 1
a141 1
//----------------------------------------------------------------------------
d218 1
a218 1
//----------------------------------------------------------------------------
d232 1
a232 1
//----------------------------------------------------------------------------
d260 1
a260 1
  // Analyse the spectral axis type.
d273 1
a273 1
  // Satisfy rest frequency/wavelength requirements.
d276 3
a278 3
      // VRAD-V2F, VOPT-V2W, and ZOPT-V2W require the rest frequency or
      // wavelength for the S-P and P-X transformations but not for S-X
      // so supply a phoney value.
d305 1
a305 1
  // Set pointers-to-functions for the linear part of the transformation.
d308 1
a308 1
      // Frequency.
d314 1
a314 1
      // Angular frequency.
d320 1
a320 1
      // Photon energy.
d326 1
a326 1
      // Wave number.
d332 1
a332 1
      // Radio velocity.
d340 1
a340 1
      // Vacuum wavelengths.
d346 1
a346 1
      // Optical velocity.
d352 1
a352 1
      // Redshift.
d360 1
a360 1
      // Air wavelengths.
d368 1
a368 1
      // Relativistic velocity.
d374 1
a374 1
      // Velocity ratio (v/c).
d382 2
a383 2
  // Set pointers-to-functions for the non-linear part of the spectral
  // transformation.
d386 1
a386 1
    // Axis is linear in frequency.
d407 1
a407 1
    // Axis is linear in vacuum wavelengths.
d428 1
a428 1
      // Grism in vacuum.
d434 1
a434 1
    // Axis is linear in air wavelengths.
d455 1
a455 1
      // Grism in air.
d461 1
a461 1
    // Axis is linear in relativistic velocity.
d483 1
a483 1
  // Check for grism axes.
d485 1
a485 1
    // Axis is linear in "grism parameter"; work in wavelength.
d488 1
a488 1
    // Set defaults.
d497 1
a497 1
    // Compute intermediaries.
d521 1
a521 1
//----------------------------------------------------------------------------
d543 1
a543 1
  // Initialize.
d551 1
a551 1
  // Convert intermediate world coordinate x to X.
d560 1
a560 1
  // If X is the grism parameter then convert it to wavelength.
d569 2
a570 2
  // Apply the non-linear step of the algorithm chain to convert the
  // X-type spectral variable to P-type intermediate spectral variable.
d585 2
a586 2
  // Apply the linear step of the algorithm chain to convert P-type
  // intermediate spectral variable to the required S-type variable.
d607 1
a607 1
//----------------------------------------------------------------------------
d629 1
a629 1
  // Initialize.
d637 2
a638 2
  // Apply the linear step of the algorithm chain to convert the S-type
  // spectral variable to P-type intermediate spectral variable.
d652 1
a652 1
    // Just a copy.
d663 2
a664 2
  // Apply the non-linear step of the algorithm chain to convert P-type
  // intermediate spectral variable to X-type spectral variable.
d679 1
a679 1
    // Convert X-type spectral variable (wavelength) to grism parameter.
d696 1
a696 1
  // Convert X-type spectral variable to intermediate world coordinate x.
d712 1
a712 1
//----------------------------------------------------------------------------
d729 1
a729 1
// : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : :
d750 1
a750 1
  // Copy with blank padding.
d754 1
a754 1
  // Validate the S-type spectral variable.
d808 1
a808 1
  // Determine X-type and validate the spectral algorithm code.
d810 1
a810 1
    // The algorithm code must be completely blank.
d823 1
a823 1
    // Logarithmic or tabular axis, not linear in any spectral type.
d826 1
a826 1
    // Validate the algorithm code.
d832 1
a832 1
    // Grism coordinates...
d834 1
a834 1
      // ...in vacuum.
d837 1
a837 1
      // ...in air.
d845 1
a845 1
    // Algorithm code has invalid syntax.
d849 1
a849 1
    // The P-, and S-type variables are inconsistent.
d855 1
a855 1
    // Degenerate algorithm code.
d860 1
a860 1
  // Rest freq/wavelength required for transformation between P and X?
d870 1
a870 1
    // Invalid X-type variable code.
d876 1
a876 1
  // Copy results.
d892 1
a892 1
//----------------------------------------------------------------------------
d910 1
a910 1
// : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : :
d933 1
a933 1
  // Analyse the spectral axis code.
d940 1
a940 1
    // Can't handle logarithmic or tabular coordinates.
d945 1
a945 1
  // Do we have rest frequency and/or wavelength as required?
d951 1
a951 1
  // Compute all spectral parameters and their derivatives.
d967 1
a967 1
  // Transform S-P (linear) and P-X (non-linear).
d1066 1
a1066 1
//----------------------------------------------------------------------------
d1084 1
a1084 1
// : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : :
d1106 1
a1106 1
  // Analyse the spectral axis type.
d1113 1
a1113 1
    // Can't handle logarithmic or tabular coordinates.
d1118 1
a1118 1
  // Do we have rest frequency and/or wavelength as required?
d1124 1
a1124 1
  // Compute all spectral parameters and their derivatives.
d1149 1
a1149 1
  // Transform X-P (non-linear) and P-S (linear).
d1243 1
a1243 1
//----------------------------------------------------------------------------
d1260 1
a1260 1
// : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : :
d1281 3
a1283 3
    // If translating between two velocity-characteristic types, or between
    // two wave-characteristic types, then we may need to set a dummy rest
    // frequency or wavelength to perform the calculations.
d1298 1
a1298 1
  // Pad with blanks.
d1304 1
a1304 1
    // Set the algorithm code if required.
d1320 1
a1320 1
  // Are the X-types compatible?
d1339 1
a1339 1
//----------------------------------------------------------------------------
d1353 1
a1353 1
  // Make a null-filled copy of ctypeA.
d1359 1
a1359 1
  // Is it a recognized AIPS-convention type?
d1364 1
a1364 1
    // Look for the Doppler frame.
d1373 1
a1373 1
        // Not a recognized AIPS spectral type.
d1381 1
a1381 1
    // VELREF takes precedence if present.
d1391 1
a1391 1
      // Check that we found an AIPS-convention Doppler frame.
d1393 1
a1393 1
        // 'VELO' in AIPS means radio or optical depending on VELREF.
d1404 2
a1405 2
      // Uniform in frequency but expressed as an optical velocity (strictly
      // we should also have found an AIPS-convention Doppler frame).
@


7.3.1.3
log
@Updated date in copyright notice.
@
text
@d3 1
a3 1
  Copyright (C) 1995-2021, Mark Calabretta
d24 1
a24 1
  $Id: spc.c,v 7.3.1.2 2020/08/17 11:19:09 mcalabre Exp mcalabre $
@


7.3.1.4
log
@Removed my email address from the copyright notice.
@
text
@d20 2
d24 1
a24 1
  $Id: spc.c,v 7.3.1.3 2021/01/19 14:09:10 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: spc.c,v 7.1.1.1 2019/12/31 13:28:19 mcalabre Exp mcalabre $
@


7.2.1.1
log
@WCSLIB 7.2 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 7.2 2020/03/09 07:31:23 mcalabre Exp $
@


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: spc.c,v 6.4.1.3 2019/12/31 03:28:03 mcalabre Exp mcalabre $
@


7.1.1.1
log
@WCSLIB 7.1 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,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: spc.c,v 6.3.1.1 2019/07/12 07:34:37 mcalabre Exp mcalabre $
d262 1
a262 1
  strncpy(ctype, spc->type, 4);
d878 1
a878 1
    strncpy(stype, ctype, 4);
@


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


6.4.1.2
log
@In spcset() and spctype(), as recommended in the GCC 9.2.0 man page,
substituted memcpy() for two instances of strncpy() that generated nuisance
warnings with -Wstringop-truncation (via -Wall).
@
text
@d25 1
a25 1
  $Id: spc.c,v 6.4.1.1 2019/08/15 09:31:29 mcalabre Exp mcalabre $
d262 1
a262 1
  memcpy(ctype, spc->type, 4);
d878 1
a878 1
    memcpy(stype, ctype, 4);
@


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: spc.c,v 6.4.1.2 2019/12/01 04:50:51 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: spc.c,v 6.2.1.3 2019/07/08 03:31:09 mcalabre Exp mcalabre $
@


6.3.1.1
log
@WCSLIB 6.3 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 6.3 2019/07/12 07:33:39 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: spc.c,v 6.1.1.1 2018/10/19 08:36:15 mcalabre Exp mcalabre $
d136 1
a136 4
  if (spc->err) {
    free(spc->err);
    spc->err = 0x0;
  }
d961 1
a961 1
      free(spx.err);
d1143 1
a1143 1
      free(spx.err);
@


6.2.1.1
log
@WCSLIB 6.2 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 6.2 2018/10/20 10:03:13 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: spc.c,v 6.2.1.1 2018/10/20 10:04:15 mcalabre Exp mcalabre $
@


6.2.1.3
log
@In spcfree() and spcspxe(), use wcserr_clear() to free the wcserr struct,
including any memory that may have been allocated to store a message.
@
text
@d25 1
a25 1
  $Id: spc.c,v 6.2.1.2 2019/05/10 01:56:50 mcalabre Exp mcalabre $
d136 4
a139 1
  wcserr_clear(&(spc->err));
d964 1
a964 1
      wcserr_clear(&(spx.err));
d1146 1
a1146 1
      wcserr_clear(&(spx.err));
@


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: spc.c,v 5.20.1.1 2018/10/05 05:33:33 mcalabre Exp mcalabre $
@


6.1.1.1
log
@WCSLIB 6.1 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,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: spc.c,v 5.19.1.1 2018/07/26 15:41:40 mcalabre Exp mcalabre $
@


5.20.1.1
log
@WCSLIB 5.20 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 5.20 2018/10/05 05:32:41 mcalabre Exp $
@


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: spc.c,v 5.18.1.2 2018/07/25 00:22:45 mcalabre Exp mcalabre $
@


5.19.1.1
log
@WCSLIB 5.19 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 5.19 2018/07/26 15:37:04 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: spc.c,v 5.17.1.2 2018/01/10 08:25:34 mcalabre Exp mcalabre $
d210 1
a210 1
    wcsutil_fptr2str((int (*)(void))spc->spxX2P, hext));
d212 1
a212 1
    wcsutil_fptr2str((int (*)(void))spc->spxP2S, hext));
d214 1
a214 1
    wcsutil_fptr2str((int (*)(void))spc->spxS2P, hext));
d216 1
a216 1
    wcsutil_fptr2str((int (*)(void))spc->spxP2X, hext));
@


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


5.18.1.2
log
@Changed function prototype of wcsutil_fptr2str() to avert
-Wcast-function-type warnings from gcc 8.1.0.
@
text
@d25 1
a25 1
  $Id: spc.c,v 5.18.1.1 2018/01/10 08:33:04 mcalabre Exp mcalabre $
d210 1
a210 1
    wcsutil_fptr2str((void (*)(void))spc->spxX2P, hext));
d212 1
a212 1
    wcsutil_fptr2str((void (*)(void))spc->spxP2S, hext));
d214 1
a214 1
    wcsutil_fptr2str((void (*)(void))spc->spxS2P, hext));
d216 1
a216 1
    wcsutil_fptr2str((void (*)(void))spc->spxP2X, hext));
@


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: spc.c,v 5.16.1.1 2017/01/15 04:28:59 mcalabre Exp mcalabre $
@


5.17.1.1
log
@WCSLIB 5.17 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 5.17 2017/09/18 08:44:23 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: spc.c,v 5.17.1.1 2017/09/18 08:45:59 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: spc.c,v 5.15.1.2 2017/01/15 04:13:33 mcalabre Exp mcalabre $
@


5.16.1.1
log
@WCSLIB 5.16 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 5.16 2017/01/15 04:25:01 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: spc.c,v 5.14.1.1 2016/02/07 10:52:44 mcalabre Exp mcalabre $
@


5.15.1.1
log
@WCSLIB 5.15 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 5.15 2016/04/05 12:55:10 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: spc.c,v 5.15.1.1 2016/04/05 12:58:35 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: spc.c,v 5.13.1.1 2016/01/26 08:54:32 mcalabre Exp mcalabre $
@


5.14.1.1
log
@WCSLIB 5.14 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 5.14 2016/02/07 10:49:31 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: spc.c,v 5.12.1.2 2016/01/25 05:17:04 mcalabre Exp mcalabre $
@


5.13.1.1
log
@WCSLIB 5.13 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 5.13 2016/01/26 08:51:13 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: spc.c,v 5.11.1.1 2015/10/18 09:16:27 mcalabre Exp mcalabre $
@


5.12.1.1
log
@WCSLIB 5.12 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 5.12 2015/11/15 02:13:00 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: spc.c,v 5.12.1.1 2015/11/15 02:16:14 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: spc.c,v 5.10.1.1 2015/10/09 08:22:35 mcalabre Exp mcalabre $
@


5.11.1.1
log
@WCSLIB 5.11 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 5.11 2015/10/18 09:13:05 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: spc.c,v 5.9.1.1 2015/07/21 09:28:07 mcalabre Exp mcalabre $
@


5.10.1.1
log
@WCSLIB 5.10 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 5.10 2015/10/09 08:19:15 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: spc.c,v 5.8.1.1 2015/07/08 11:07:18 mcalabre Exp mcalabre $
@


5.9.1.1
log
@WCSLIB 5.9 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 5.9 2015/07/21 09:20:01 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: spc.c,v 5.7.1.1 2015/06/29 02:47:24 mcalabre Exp mcalabre $
@


5.8.1.1
log
@WCSLIB 5.8 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 5.8 2015/07/08 11:03:59 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: spc.c,v 5.6.1.2 2015/06/18 08:13:03 mcalabre Exp mcalabre $
@


5.7.1.1
log
@WCSLIB 5.7 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 5.7 2015/06/29 02:44:16 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: spc.c,v 5.5.1.1 2015/05/05 13:21:00 mcalabre Exp mcalabre $
d217 14
@


5.6.1.1
log
@WCSLIB 5.6 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 5.6 2015/06/14 07:11:24 mcalabre Exp $
@


5.6.1.2
log
@Added spcperr().
@
text
@d25 1
a25 1
  $Id: spc.c,v 5.6.1.1 2015/06/14 07:14:44 mcalabre Exp mcalabre $
a216 14

  return 0;
}

/*--------------------------------------------------------------------------*/

int spcperr(const struct spcprm *spc, const char *prefix)

{
  if (spc == 0x0) return SPCERR_NULL_POINTER;

  if (spc->err) {
    wcserr_prt(spc->err, prefix);
  }
@


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: spc.c,v 5.4.1.1 2015/04/21 14:44:28 mcalabre Exp mcalabre $
@


5.5.1.1
log
@WCSLIB 5.5 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 5.5 2015/05/05 13:16:31 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: spc.c,v 5.3.1.1 2015/04/21 02:54:02 mcalabre Exp mcalabre $
@


5.4.1.1
log
@WCSLIB 5.4 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 5.4 2015/04/21 14:41:05 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: spc.c,v 5.2.1.1 2015/04/15 12:39:14 mcalabre Exp mcalabre $
@


5.3.1.1
log
@WCSLIB 5.3 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 5.3 2015/04/21 02:50:51 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: spc.c,v 5.1.1.1 2015/04/07 11:01:10 mcalabre Exp mcalabre $
@


5.2.1.1
log
@WCSLIB 5.2 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 5.2 2015/04/15 12:35:07 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: spc.c,v 5.0.1.1 2015/04/05 12:28:00 mcalabre Exp mcalabre $
@


5.1.1.1
log
@WCSLIB 5.1 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 5.1 2015/04/07 10:56:36 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: spc.c,v 4.25.1.5 2015/04/03 01:30:55 mcalabre Exp mcalabre $
@


5.0.1.1
log
@WCSLIB 5.0 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 5.0 2015/04/05 12:24:59 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: spc.c,v 4.24.1.1 2014/09/18 15:28:09 mcalabre Exp mcalabre $
d71 11
d126 1
a126 1
  return SPCERR_SUCCESS;
d141 1
a141 1
  return SPCERR_SUCCESS;
d160 1
a160 1
    wcsprintf("      crval: %- 11.4g\n", spc->crval);
d171 1
a171 1
        wcsprintf("  %- 11.4g", spc->pv[i]);
d179 1
a179 1
        wcsprintf("  %- 11.4g", spc->pv[i]);
d190 1
a190 1
    wcsprintf("  %- 11.4g", spc->w[i]);
d195 1
a195 1
      wcsprintf("  %- 11.4g", spc->w[i]);
d218 1
a218 1
  return SPCERR_SUCCESS;
d507 1
a507 1
  return SPCERR_SUCCESS;
d524 1
a524 1
  int statP2S, status = SPCERR_SUCCESS, statX2P;
d569 1
a569 1
        return wcserr_set(SPC_ERRMSG(statX2P));
d585 1
a585 1
        return wcserr_set(SPC_ERRMSG(statP2S));
d610 1
a610 1
  int statP2X, status = SPCERR_SUCCESS, statS2P;
d636 1
a636 1
        return wcserr_set(SPC_ERRMSG(statS2P));
d662 1
a662 1
        return wcserr_set(SPC_ERRMSG(statP2X));
d878 1
a878 1
  return SPCERR_SUCCESS;
d928 1
a928 1
  if (strstr("LT", xtype)) {
d944 1
a944 1
    status = SPCERR_BAD_SPEC_PARAMS;
d946 3
a948 2
      *err = spx.err;
      (*err)->status = status;
d1052 1
a1052 1
  return SPCERR_SUCCESS;
d1101 1
a1101 1
  if (strstr("LT", xtype)) {
d1126 1
a1126 1
    status = SPCERR_BAD_SPEC_PARAMS;
d1128 3
a1130 2
      *err = spx.err;
      (*err)->status = status;
d1229 1
a1229 1
  return SPCERR_SUCCESS;
d1325 1
a1325 1
  return SPCERR_SUCCESS;
d1367 1
a1367 1
      status = SPCERR_SUCCESS;
d1374 1
a1374 1
      status = SPCERR_SUCCESS;
d1396 1
a1396 1
      if (status < 0) status = SPCERR_SUCCESS;
@


4.25.1.1
log
@WCSLIB 4.25 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 4.25 2014/12/14 14:29:36 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: spc.c,v 4.25.1.1 2014/12/14 14:32:45 mcalabre Exp mcalabre $
@


4.25.1.3
log
@In each of spcspxe() and spcxpse(), replaced one occurence of strstr() used
incorrectly with strchr().
@
text
@d25 1
a25 1
  $Id: spc.c,v 4.25.1.2 2015/01/06 01:01:06 mcalabre Exp mcalabre $
d917 1
a917 1
  if (strchr("LT", (int)(*xtype))) {
d1089 1
a1089 1
  if (strchr("LT", (int)(*xtype))) {
@


4.25.1.4
log
@In spcspxe() and spcxpse(), when handling the status return from specx(),
spx.err may be a null pointer if error reporting is not enabled.
@
text
@d25 1
a25 1
  $Id: spc.c,v 4.25.1.3 2015/03/05 10:09:30 mcalabre Exp mcalabre $
d935 2
a936 3
      if ((*err = spx.err)) {
        (*err)->status = status;
      }
d1116 2
a1117 3
      if ((*err = spx.err)) {
        (*err)->status = status;
      }
@


4.25.1.5
log
@Created spc_spcerr[] to map status returns from the spx routines.  Return a
successful status directly as 0 rather than the long-winded SPCERR_SUCCESS.
Tweaked output formatting in spcprt().
@
text
@d25 1
a25 1
  $Id: spc.c,v 4.25.1.4 2015/03/12 07:21:58 mcalabre Exp mcalabre $
a70 11
/* Map error returns for lower-level routines.  SPXERR_BAD_INSPEC_COORD */
/* maps to either SPCERR_BAD_X or SPCERR_BAD_SPEC depending on context. */
const int spc_spxerr[] = {

  SPCERR_SUCCESS,		/*  0: SPXERR_SUCCESS          */
  SPCERR_NULL_POINTER,		/*  1: SPXERR_NULL_POINTER     */
  SPCERR_BAD_SPEC_PARAMS,	/*  2: SPXERR_BAD_SPEC_PARAMS  */
  SPCERR_BAD_SPEC_PARAMS	/*  3: SPXERR_BAD_SPEC_VAR     */
				/*  4: SPXERR_BAD_INSPEC_COORD */
};

d115 1
a115 1
  return 0;
d130 1
a130 1
  return 0;
d149 1
a149 1
    wcsprintf("      crval: %#- 11.5g\n", spc->crval);
d160 1
a160 1
        wcsprintf("  %#- 11.5g", spc->pv[i]);
d168 1
a168 1
        wcsprintf("  %#- 11.5g", spc->pv[i]);
d179 1
a179 1
    wcsprintf("  %#- 11.5g", spc->w[i]);
d184 1
a184 1
      wcsprintf("  %#- 11.5g", spc->w[i]);
d207 1
a207 1
  return 0;
d496 1
a496 1
  return 0;
d513 1
a513 1
  int statP2S, status = 0, statX2P;
d558 1
a558 1
        return wcserr_set(SPC_ERRMSG(spc_spxerr[statX2P]));
d574 1
a574 1
        return wcserr_set(SPC_ERRMSG(spc_spxerr[statP2S]));
d599 1
a599 1
  int statP2X, status = 0, statS2P;
d625 1
a625 1
        return wcserr_set(SPC_ERRMSG(spc_spxerr[statS2P]));
d651 1
a651 1
        return wcserr_set(SPC_ERRMSG(spc_spxerr[statP2X]));
d867 1
a867 1
  return 0;
d933 1
a933 1
    status = spc_spxerr[status];
d1041 1
a1041 1
  return 0;
d1115 1
a1115 1
    status = spc_spxerr[status];
d1218 1
a1218 1
  return 0;
d1314 1
a1314 1
  return 0;
d1356 1
a1356 1
      status = 0;
d1363 1
a1363 1
      status = 0;
d1385 1
a1385 1
      if (status < 0) status = 0;
@


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: spc.c,v 4.23.1.1 2014/05/13 05:53:49 mcalabre Exp mcalabre $
@


4.24.1.1
log
@WCSLIB 4.24 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 4.24 2014/09/18 15:25:00 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: spc.c,v 4.22.1.1 2014/04/12 15:06:32 mcalabre Exp mcalabre $
@


4.23.1.1
log
@WCSLIB 4.23 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 4.23 2014/05/13 05:50:51 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: spc.c,v 4.21.1.1 2014/03/24 05:15:28 mcalabre Exp mcalabre $
@


4.22.1.1
log
@WCSLIB 4.22 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 4.22 2014/04/12 15:03:52 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: spc.c,v 4.20.1.2 2014/03/21 06:32:19 mcalabre Exp mcalabre $
@


4.21.1.1
log
@WCSLIB 4.21 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 4.21 2014/03/24 05:12:27 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: spc.c,v 4.19.1.1 2013/09/29 14:20:38 mcalabre Exp mcalabre $
@


4.20.1.1
log
@WCSLIB 4.20 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 4.20 2013/12/18 05:42:49 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: spc.c,v 4.20.1.1 2013/12/18 05:46:55 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: spc.c,v 4.18.1.1 2013/07/13 10:02:37 mcalabre Exp mcalabre $
@


4.19.1.1
log
@WCSLIB 4.19 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 4.19 2013/09/29 14:17:51 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: spc.c,v 4.17.1.1 2013/01/29 05:32:32 cal103 Exp cal103 $
@


4.18.1.1
log
@WCSLIB 4.18 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 4.18 2013/07/13 10:00:04 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: spc.c,v 4.16.1.2 2013/01/29 05:09:44 cal103 Exp cal103 $
@


4.17.1.1
log
@WCSLIB 4.17 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 4.17 2013/01/29 05:29:20 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: spc.c,v 4.15.1.1 2012/09/26 14:27:51 cal103 Exp cal103 $
@


4.16.1.1
log
@WCSLIB 4.16 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 4.16 2012/11/07 04:42:44 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: spc.c,v 4.16.1.1 2012/11/07 04:45:56 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: spc.c,v 4.14.1.2 2012/09/18 09:30:22 cal103 Exp cal103 $
@


4.15.1.1
log
@WCSLIB 4.15 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 4.15 2012/09/26 14:26:05 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: spc.c,v 4.13.1.3 2012/07/13 03:34:20 cal103 Exp cal103 $
d726 2
d935 1
d1116 1
d1253 1
a1253 1
  int  restreq;
d1269 3
a1271 3
  if (spcspxe(ctypeS1, crvalS1, restfrq, restwav, &ptype1, &xtype1,
              &restreq, &crvalX, &dXdS1, err)) {
    return (*err)->status;
d1291 3
a1293 3
  if (spcxpse(ctypeS2, crvalX, restfrq, restwav, &ptype2, &xtype2,
              &restreq, crvalS2, &dS2dX, err)) {
    return (*err)->status;
@


4.14.1.1
log
@WCSLIB 4.14 development branch.
@
text
@d25 1
a25 1
  $Id: spc.c,v 4.14 2012/07/13 10:02:27 cal103 Exp $
@


4.14.1.2
log
@Bug fixes in spctype(), spcspxe(), spcxpse, and spctrne() for propagating
an error status correctly from lower-level routines.  Reported by
Hans Terlouw.
@
text
@d25 1
a25 1
  $Id: spc.c,v 4.14.1.1 2012/07/13 10:04:44 cal103 Exp cal103 $
a725 2
  if (err) *err = 0x0;

a932 1
      *err = spx.err;
a1112 1
      *err = spx.err;
d1249 1
a1249 1
  int  restreq, status;
d1265 3
a1267 3
  if ((status = spcspxe(ctypeS1, crvalS1, restfrq, restwav, &ptype1, &xtype1,
                        &restreq, &crvalX, &dXdS1, err))) {
    return status;
d1287 3
a1289 3
  if ((status = spcxpse(ctypeS2, crvalX, restfrq, restwav, &ptype2, &xtype2,
                        &restreq, crvalS2, &dS2dX, err))) {
    return status;
@


4.13
log
@WCSLIB 4.13
@
text
@d3 1
a3 1
  WCSLIB 4.13 - an implementation of the FITS WCS standard.
d19 1
a19 1
  along with WCSLIB.  If not, see <http://www.gnu.org/licenses/>.
d21 5
a25 11
  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

  Author: Mark Calabretta, Australia Telescope National Facility
  http://www.atnf.csiro.au/~mcalabre/index.html
  $Id: spc.c,v 4.12.1.2 2012/03/14 06:36:28 cal103 Exp cal103 $
d199 1
a199 1
    wcsutil_fptr2str((int (*)())spc->spxX2P, hext));
d201 1
a201 1
    wcsutil_fptr2str((int (*)())spc->spxP2S, hext));
d203 1
a203 1
    wcsutil_fptr2str((int (*)())spc->spxS2P, hext));
d205 1
a205 1
    wcsutil_fptr2str((int (*)())spc->spxP2X, hext));
@


4.13.1.1
log
@WCSLIB 4.13 development branch.
@
text
@d31 1
a31 1
  $Id: spc.c,v 4.13 2012/03/14 07:39:30 cal103 Exp $
@


4.13.1.2
log
@Changed prototype to wcsutil_fptr2str() to fix a compiler warning.
Patch provided by Michael Droettboom.
@
text
@d31 1
a31 1
  $Id: spc.c,v 4.13.1.1 2012/03/14 07:40:37 cal103 Exp cal103 $
d205 1
a205 1
    wcsutil_fptr2str((int (*)(void))spc->spxX2P, hext));
d207 1
a207 1
    wcsutil_fptr2str((int (*)(void))spc->spxP2S, hext));
d209 1
a209 1
    wcsutil_fptr2str((int (*)(void))spc->spxS2P, hext));
d211 1
a211 1
    wcsutil_fptr2str((int (*)(void))spc->spxP2X, hext));
@


4.13.1.3
log
@Changed contact details.
@
text
@d19 1
a19 1
  along with WCSLIB.  If not, see http://www.gnu.org/licenses.
d21 11
a31 5
  Direct correspondence concerning WCSLIB to mark@@calabretta.id.au

  Author: Mark Calabretta, Australia Telescope National Facility, CSIRO.
  http://www.atnf.csiro.au/people/Mark.Calabretta
  $Id: spc.c,v 4.13.1.2 2012/07/12 15:28:47 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: spc.c,v 4.11.1.2 2012/02/29 07:16:19 cal103 Exp cal103 $
d110 2
a111 1
  spc->isGrism = 0;
d115 1
d126 1
a126 3
int spcfree(spc)

struct spcprm *spc;
d131 4
a134 2
  if (spc->err) free(spc->err);
  spc->err = 0x0;
a501 1

@


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


4.12.1.2
log
@In spcini(), also initialize spcprm::padding1 and spcprm::padding2 so that
they don't display rubbish in the debugger.
@
text
@d31 1
a31 1
  $Id: spc.c,v 4.12.1.1 2012/02/29 07:59:10 cal103 Exp cal103 $
d110 1
a110 2
  spc->isGrism  = 0;
  spc->padding1 = 0;
a113 1
  spc->padding2 = 0x0;
d124 3
a126 1
int spcfree(struct spcprm *spc)
d131 2
a132 4
  if (spc->err) {
    free(spc->err);
    spc->err = 0x0;
  }
d500 1
@


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: spc.c,v 4.10.1.2 2012/02/20 23:10:24 cal103 Exp cal103 $
d1253 2
a1254 2
  char *cp, ptype1, ptype2, xtype1, xtype2;
  int  restreq, status;
d1257 16
a1272 3
  if ((status = spcspxe(ctypeS1, crvalS1, restfrq, restwav, &ptype1, &xtype1,
                        &restreq, &crvalX, &dXdS1, err))) {
    return status;
d1275 1
a1275 1
  /* Blank fill. */
d1292 3
a1294 3
  if ((status = spcxpse(ctypeS2, crvalX, restfrq, restwav, &ptype2, &xtype2,
                        &restreq, crvalS2, &dS2dX, err))) {
    return status;
@


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


4.11.1.2
log
@In spctrne(), guard against restfrq == restwav == 0.0 when translating
between two velocity-characteristic types, or between two wave-
characteristic types (the translation is independent of restfrq and
restwav, but a dummy value is needed for intermediate calculations).
@
text
@d31 1
a31 1
  $Id: spc.c,v 4.11.1.1 2012/02/20 23:31:13 cal103 Exp cal103 $
d1253 2
a1254 2
  char *cp, ptype1, ptype2, stype1[5], stype2[5], xtype1, xtype2;
  int  restreq;
d1257 3
a1259 11
  if (restfrq == 0.0 && restwav == 0.0) {
    /* If translating between two velocity-characteristic types, or between
       two wave-characteristic types, then we may need to set a dummy rest
       frequency or wavelength to perform the calculations. */
    strncpy(stype1, ctypeS1, 4);
    strncpy(stype2, ctypeS2, 4);
    stype1[4] = stype2[4] = '\0';
    if ((strstr("VRAD VOPT ZOPT VELO BETA", stype1) != 0x0) ==
        (strstr("VRAD VOPT ZOPT VELO BETA", stype2) != 0x0)) {
      restwav = 1.0;
    }
d1262 1
a1262 6
  if (spcspxe(ctypeS1, crvalS1, restfrq, restwav, &ptype1, &xtype1,
              &restreq, &crvalX, &dXdS1, err)) {
    return (*err)->status;
  }

  /* Pad with blanks. */
d1279 3
a1281 3
  if (spcxpse(ctypeS2, crvalX, restfrq, restwav, &ptype2, &xtype2,
              &restreq, crvalS2, &dS2dX, err)) {
    return (*err)->status;
@


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: spc.c,v 4.9.1.2 2012/02/02 08:17:39 cal103 Exp cal103 $
d94 1
d235 1
a235 1
  spc->type[4] = '\0';
d237 2
d243 5
a247 1
  sprintf(ctype, "%s-%s", spc->type, spc->code);
@


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


4.10.1.2
log
@Bug fix in spcset() for handling simple linear spectral axes.
@
text
@d31 1
a31 1
  $Id: spc.c,v 4.10.1.1 2012/02/05 23:42:46 cal103 Exp cal103 $
a93 1
  memset(spc->type, 0, 8);
d234 1
a234 1
  memset((spc->type)+4, 0, 4);
a235 2
  wcsutil_blank_fill(4, spc->type);
  wcsutil_blank_fill(3, spc->code);
d240 1
a240 5
  memset(ctype, 0, 9);
  strncpy(ctype, spc->type, 4);
  if (*(spc->code) != ' ') {
    sprintf(ctype+4, "-%s", spc->code);
  }
@


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: spc.c,v 4.8.1.3 2012/01/24 05:23:06 cal103 Exp cal103 $
d118 1
a118 1
  return 0;
d133 1
a133 1
  return 0;
d210 1
a210 1
  return 0;
d494 1
a494 1
  return 0;
d511 1
a511 1
  int statP2S, status = 0, statX2P;
d597 1
a597 1
  int statP2X, status = 0, statS2P;
d863 1
a863 1
  return 0;
d1035 1
a1035 1
  return 0;
d1210 1
a1210 1
  return 0;
d1293 1
a1293 1
  return 0;
d1308 1
a1308 1
  int  ivf;
d1317 1
d1331 1
a1331 1
        return -1;
d1335 1
d1340 1
a1340 1
    if (1 <= ivf && ivf <= 7) {
d1342 3
d1351 4
a1354 1
        if (velref&256) {
d1357 1
a1357 1
          strcpy(ctype, "VOPT");
d1364 1
a1365 2

    return 0;
d1368 1
a1368 1
  return -1;
@


4.9.1.1
log
@WCSLIB 4.9 development branch.
@
text
@d31 1
a31 1
  $Id: spc.c,v 4.9 2012/01/24 05:40:29 cal103 Exp $
@


4.9.1.2
log
@In some circumstances, spcaips() could return status 0 when it had not
made a change.  It will now also return an error status for invalid
values of velref.
@
text
@d31 1
a31 1
  $Id: spc.c,v 4.9.1.1 2012/01/24 05:41:45 cal103 Exp cal103 $
d118 1
a118 1
  return SPCERR_SUCCESS;
d133 1
a133 1
  return SPCERR_SUCCESS;
d210 1
a210 1
  return SPCERR_SUCCESS;
d494 1
a494 1
  return SPCERR_SUCCESS;
d511 1
a511 1
  int statP2S, status = SPCERR_SUCCESS, statX2P;
d597 1
a597 1
  int statP2X, status = SPCERR_SUCCESS, statS2P;
d863 1
a863 1
  return SPCERR_SUCCESS;
d1035 1
a1035 1
  return SPCERR_SUCCESS;
d1210 1
a1210 1
  return SPCERR_SUCCESS;
d1293 1
a1293 1
  return SPCERR_SUCCESS;
d1308 1
a1308 1
  int  ivf, status;
a1316 1
  status = SPCERR_NO_CHANGE;
d1330 1
a1330 1
        return SPCERR_NO_CHANGE;
a1333 1
      status = SPCERR_SUCCESS;
d1338 1
a1338 1
    if (0 < ivf && ivf <= 7) {
a1339 3
      status = SPCERR_SUCCESS;
    } else if (ivf) {
      status = SPCERR_BAD_SPEC_PARAMS;
d1346 1
a1346 4
        ivf = velref/256;
        if (ivf == 0) {
          strcpy(ctype, "VOPT");
        } else if (ivf == 1) {
d1349 1
a1349 1
          status = SPCERR_BAD_SPEC_PARAMS;
a1355 1
      if (status < 0) status = SPCERR_SUCCESS;
d1357 2
d1361 1
a1361 1
  return status;
@


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: spc.c,v 4.7.1.6 2011/08/15 03:22:25 cal103 Exp cal103 $
d198 1
a198 1
    wcserr_prt(spc->err, "");
@


4.8.1.1
log
@WCSLIB 4.8 development branch.
@
text
@d31 1
a31 1
  $Id: spc.c,v 4.8 2011/08/15 08:05:53 cal103 Exp $
@


4.8.1.2
log
@Minor refinement in spcprt() for printing spcprm::err.
@
text
@d31 1
a31 1
  $Id: spc.c,v 4.8.1.1 2011/08/15 08:07:06 cal103 Exp cal103 $
d198 1
a198 1
    wcserr_prt(spc->err, "             ");
@


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: spc.c,v 4.8.1.2 2011/11/17 03:09:12 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: spc.c,v 4.6.1.3 2011/01/25 00:35:11 cal103 Exp cal103 $
d36 1
d39 1
d77 3
d90 1
a90 1
  if (spc == 0x0) return 1;
d111 2
d123 15
d141 2
a142 1
  int i;
d144 1
a144 1
  if (spc == 0x0) return 1;
d195 14
a208 4
  wcsprintf("     spxX2P: %p\n", (void *)spc->spxX2P);
  wcsprintf("     spxP2S: %p\n", (void *)spc->spxP2S);
  wcsprintf("     spxS2P: %p\n", (void *)spc->spxS2P);
  wcsprintf("     spxP2X: %p\n", (void *)spc->spxP2X);
d218 2
d224 1
d226 2
a227 1
  if (spc == 0x0) return 1;
d230 2
a231 1
    return 2;
d243 2
a244 2
  if ((status = spcspx(ctype, spc->crval, restfrq, restwav, &ptype, &xtype,
                       &restreq, &crvalX, &dXdS))) {
d509 2
d517 1
d519 3
a522 2
  /* Initialize. */
  if (spc == 0x0) return 1;
d524 1
a524 1
    if (spcset(spc)) return 2;
d550 5
a554 2
      if (statX2P == 4) {
        status = 3;
d556 1
a556 1
        return statX2P;
d566 5
a570 2
      if (statP2S == 4) {
        status = 3;
d572 1
a572 1
        return statP2S;
d577 3
d595 2
d603 1
d605 3
a608 2
  /* Initialize. */
  if (spc == 0x0) return 1;
d610 1
a610 1
    if (spcset(spc)) return 2;
d617 5
a621 2
      if (statS2P == 4) {
        status = 4;
d623 1
a623 1
        return statS2P;
d643 5
a647 2
      if (statP2X == 4) {
        status = 4;
d649 1
a649 1
        return statP2X;
d682 3
d701 20
d777 2
a778 1
    return 2;
d786 2
a787 1
      return 2;
d793 2
a794 1
    return 2;
d802 2
a803 1
      return 2;
d814 2
a815 1
      return 2;
d820 2
a821 2
    return 2;

d824 3
a826 1
    return 2;
d845 2
a846 1
    return 2;
d880 21
d906 1
d908 3
a910 2
  if (spctyp(ctypeS, stype, scode, 0x0, 0x0, ptype, xtype, restreq)) {
    return 2;
d915 2
a916 1
    return 2;
d921 2
a922 1
    return 2;
d927 1
d929 7
a935 1
    return 2;
d1052 21
d1079 3
a1081 2
  if (spctyp(ctypeS, stype, scode, 0x0, 0x0, ptype, xtype, restreq)) {
    return 2;
d1086 2
a1087 1
    return 2;
d1092 2
a1093 1
    return 2;
d1107 9
a1115 2
  if ((status = specx(type, crvalX, restfrq, restwav, &spx))) {
    return 2;
d1226 20
d1250 2
a1251 2
  if ((status = spcspx(ctypeS1, crvalS1, restfrq, restwav, &ptype1, &xtype1,
                       &restreq, &crvalX, &dXdS1))) {
d1272 2
a1273 2
  if ((status = spcxps(ctypeS2, crvalX, restfrq, restwav, &ptype2, &xtype2,
                       &restreq, crvalS2, &dS2dX))) {
d1279 2
a1280 1
    return 2;
d1321 1
a1321 1
    if ((fcode = ctype+4)) {
@


4.7.1.1
log
@WCSLIB 4.7 development branch.
@
text
@d31 1
a31 1
  $Id: spc.c,v 4.7 2011/02/07 07:03:42 cal103 Exp $
@


4.7.1.2
log
@Added error messaging based on wcserr.  Changes supplied by Michael
Droettboom (STScI) with respect to the released WCSLIB 4.7 sources.
@
text
@d85 1
a85 1
  if (spc == 0x0) return SPCERR_NULL_POINTER;
a86 2
  wcserr_ini(&spc->err);
  
d121 1
a121 1
  if (spc == 0x0) return SPCERR_NULL_POINTER;
d190 1
a190 1
  if (spc == 0x0) return SPCERR_NULL_POINTER;
d193 1
a193 3
    return WCSERR_SET(
      &spc->err, SPCERR_BAD_SPEC_PARAMS,
      "Spectral crval is undefined");
d205 2
a206 2
  if ((status = spcspx_err(ctype, spc->crval, restfrq, restwav, &ptype, &xtype,
                           &restreq, &crvalX, &dXdS, &spc->err))) {
d480 1
a480 1
  if (spc == 0x0) return SPCERR_NULL_POINTER;
d482 1
a482 1
    if (status = spcset(spc)) return status;
d508 2
a509 6
      if (statX2P == SPXERR_BAD_INSPEC_COORD) {
        status = SPCERR_BAD_X;
      } else if (statX2P == SPXERR_BAD_SPEC_PARAMS) {
        return WCSERR_SET(
          &spc->err, SPCERR_BAD_SPEC_PARAMS,
          "Invalid spectral parameters: Frequency or wavelength is 0");
d511 1
a511 1
        return WCSERR_SET(&spc->err, statX2P, spc_errmsg[statX2P]);
d521 2
a522 6
      if (statP2S == SPXERR_BAD_INSPEC_COORD) {
        status = SPCERR_BAD_X;
      } else if (statP2S == SPXERR_BAD_SPEC_PARAMS) {
        return WCSERR_SET(
          &spc->err, SPCERR_BAD_SPEC_PARAMS,
          "Invalid spectral parameters: Frequency or wavelength is 0");
d524 1
a524 1
        return WCSERR_SET(&spc->err, statP2S, spc_errmsg[statP2S]);
a528 3
  if (status == SPCERR_BAD_X) {
    WCSERR_SET(&spc->err, SPCERR_BAD_X, spc_errmsg[SPCERR_BAD_X]);
  }
d553 1
a553 1
  if (spc == 0x0) return SPCERR_NULL_POINTER;
d555 1
a555 1
    if (status = spcset(spc)) return status;
d562 2
a563 6
      if (statS2P == SPXERR_BAD_INSPEC_COORD) {
        status = SPCERR_BAD_SPEC;
      } else if (statS2P == SPXERR_BAD_SPEC_PARAMS) {
        return WCSERR_SET(
          &spc->err, SPCERR_BAD_SPEC_PARAMS,
          "Invalid spectral parameters: Frequency or wavelength is 0");
d565 1
a565 1
        return WCSERR_SET(&spc->err, statS2P, spc_errmsg[statS2P]);
d585 2
a586 6
      if (statP2X == SPCERR_BAD_SPEC) {
        status = SPCERR_BAD_SPEC;
      } else if (statP2X == SPXERR_BAD_SPEC_PARAMS) {
        return WCSERR_SET(
          &spc->err, SPCERR_BAD_SPEC_PARAMS,
          "Invalid spectral parameters: Frequency or wavelength is 0");
d588 1
a588 1
        return WCSERR_SET(&spc->err, statP2X, spc_errmsg[statP2X]);
a620 3
  if (status == SPCERR_BAD_SPEC) {
    WCSERR_SET(&spc->err, SPCERR_BAD_SPEC, spc_errmsg[SPCERR_BAD_SPEC]);
  }
a636 16
  return spctyp_err(
    ctypei, stype, scode, sname, units, ptype, xtype, restreq, NULL);
}

int spctyp_err(
  const char ctypei[9],
  char stype[],
  char scode[],
  char sname[],
  char units[],
  char *ptype,
  char *xtype,
  int  *restreq,
  struct wcserr *err)

{
d693 1
a693 3
    return WCSERR_SET(
      err, SPCERR_BAD_SPEC_PARAMS,
      "Unknown spectral type '%s'", ctype);
d701 1
a701 3
      return WCSERR_SET(
        err, SPCERR_BAD_SPEC_PARAMS,
        "Invalid spectral algorithm '%s'", ctype+4);
d707 1
a707 3
    return WCSERR_SET(
      err, SPCERR_BAD_SPEC_PARAMS,
      "Invalid spectral type '%s'", ctype);
d715 1
a715 3
      return WCSERR_SET(
        err, SPCERR_BAD_SPEC_PARAMS,
        "Invalid spectral algorithm '%s'", xtype_t);
d726 1
a726 3
      return WCSERR_SET(
        err, SPCERR_BAD_SPEC_PARAMS,
        "Invalid spectral algorithm '%s'", xtype_t);
d731 2
a732 3
    return WCSERR_SET(
      err, SPCERR_BAD_SPEC_PARAMS,
      "Invalid spectral algorithm syntax '%s'", xtype_t);
d735 1
a735 3
    return WCSERR_SET(
      err, SPCERR_BAD_SPEC_PARAMS,
      "In spectral type '%s', P- and S-type variables are inconsistent", ctype);
d754 1
a754 3
    return WCSERR_SET(
      err, SPCERR_BAD_SPEC_PARAMS,
      "In spectral type '%s', invalid X-type variable code", ctype);
a787 17
  return spcspx_err(
    ctypeS, crvalS, restfrq, restwav, ptype, xtype, restreq, crvalX, dXdS, NULL);
}

int spcspx_err(
  const char ctypeS[9],
  double crvalS,
  double restfrq,
  double restwav,
  char *ptype,
  char *xtype,
  int *restreq,
  double *crvalX,
  double *dXdS,
  struct wcserr *err)

{
d794 2
a795 3
  if (status = spctyp_err(
        ctypeS, stype, scode, 0x0, 0x0, ptype, xtype, restreq, err)) {
    return status;
d800 1
a800 3
    return WCSERR_SET(
      err, SPCERR_BAD_SPEC_PARAMS,
      "Can't handle logarithmic or tabular coordinates");
d805 1
a805 3
    return WCSERR_SET(
      err, SPCERR_BAD_SPEC_PARAMS,
      "Missing required rest frequency or wavelength");
d811 1
a811 3
    wcserr_copy(err, &spx.err);
    err->status = SPCERR_BAD_SPEC_PARAMS;
    return SPCERR_BAD_SPEC_PARAMS;
a927 17
  return spcxps_err(
    ctypeS, crvalX, restfrq, restwav, ptype, xtype, restreq, crvalS, dSdX, NULL);
}

int spcxps_err(
  const char ctypeS[9],
  double crvalX,
  double restfrq,
  double restwav,
  char *ptype,
  char *xtype,
  int *restreq,
  double *crvalS,
  double *dSdX,
  struct wcserr *err)

{
d934 2
a935 3
  if (status = spctyp_err(
        ctypeS, stype, scode, 0x0, 0x0, ptype, xtype, restreq, err)) {
    return status;
d940 1
a940 3
    return WCSERR_SET(
      err, SPCERR_BAD_SPEC_PARAMS,
      "Can't handle logarithmic or tabular coordinates");
d945 1
a945 3
    return WCSERR_SET(
      err, SPCERR_BAD_SPEC_PARAMS,
      "Missing required rest frequency or wavelength");
d960 1
a960 3
    wcserr_copy(err, &spx.err);
    err->status = SPCERR_BAD_SPEC_PARAMS;
    return SPCERR_BAD_SPEC_PARAMS;
a1070 16
  return spctrn_err(
    ctypeS1, crvalS1, cdeltS1, restfrq, restwav, ctypeS2, crvalS2, cdeltS2, NULL);
}

int spctrn_err(
  const char ctypeS1[9],
  double crvalS1,
  double cdeltS1,
  double restfrq,
  double restwav,
  char   ctypeS2[9],
  double *crvalS2,
  double *cdeltS2,
  struct wcserr *err)

{
d1075 2
a1076 2
  if ((status = spcspx_err(ctypeS1, crvalS1, restfrq, restwav, &ptype1,
                           &xtype1, &restreq, &crvalX, &dXdS1, err))) {
d1097 2
a1098 2
  if ((status = spcxps_err(ctypeS2, crvalX, restfrq, restwav, &ptype2, &xtype2,
                           &restreq, crvalS2, &dS2dX, err))) {
d1104 1
a1104 3
    return WCSERR_SET(
      err, SPCERR_BAD_SPEC_PARAMS,
      "Incompatible X-types '%c' and '%c'", xtype1, xtype2);
@


4.7.1.3
log
@Revised implementation of Michael Droettboom's error messaging system.
@
text
@d31 1
a31 1
  $Id: spc.c,v 4.7.1.1 2011/02/07 07:04:22 cal103 Exp cal103 $
a35 1
#include <stdlib.h>
a37 1
#include "wcserr.h"
a74 3
/* Convenience macro for invoking wcserr_set(). */
#define SPC_ERRMSG(status) WCSERR_SET(status), spc_errmsg[status]

d87 2
a107 2
  spc->err = 0x0;

a117 15
int spcfree(spc)

struct spcprm *spc;

{
  if (spc == 0x0) return SPCERR_NULL_POINTER;

  if (spc->err) free(spc->err);
  spc->err = 0x0;

  return 0;
}

/*--------------------------------------------------------------------------*/

d121 1
a121 2
  char hext[32];
  int  i;
d174 4
a177 14

  wcsprintf("        err: %p\n", (void *)spc->err);
  if (spc->err) {
    wcserr_prt(spc->err, "");
  }

  wcsprintf("     spxX2P: %s\n",
    wcsutil_fptr2str((int (*)())spc->spxX2P, hext));
  wcsprintf("     spxP2S: %s\n",
    wcsutil_fptr2str((int (*)())spc->spxP2S, hext));
  wcsprintf("     spxS2P: %s\n",
    wcsutil_fptr2str((int (*)())spc->spxS2P, hext));
  wcsprintf("     spxP2X: %s\n",
    wcsutil_fptr2str((int (*)())spc->spxP2X, hext));
a186 2
  static const char *function = "spcset";

a190 1
  struct wcserr **err;
a192 1
  err = &(spc->err);
d195 2
a196 1
    return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
d209 2
a210 2
  if ((status = spcspxe(ctype, spc->crval, restfrq, restwav, &ptype, &xtype,
                        &restreq, &crvalX, &dXdS, &(spc->err)))) {
a474 2
  static const char *function = "spcx2s";

d481 1
a481 1
  struct wcserr **err;
a484 2
  err = &(spc->err);

d486 1
a486 1
    if ((status = spcset(spc))) return status;
d515 2
a516 1
        return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
d519 1
a519 1
        return wcserr_set(SPC_ERRMSG(statX2P));
d532 2
a533 1
        return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
d536 1
a536 1
        return wcserr_set(SPC_ERRMSG(statP2S));
d541 2
a542 2
  if (status) {
    wcserr_set(SPC_ERRMSG(status));
a558 2
  static const char *function = "spcs2x";

d565 1
a565 1
  struct wcserr **err;
a568 2
  err = &(spc->err);

d570 1
a570 1
    if ((status = spcset(spc))) return status;
d580 2
a581 1
        return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
d584 1
a584 1
        return wcserr_set(SPC_ERRMSG(statS2P));
d607 2
a608 1
        return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
d611 1
a611 1
        return wcserr_set(SPC_ERRMSG(statP2X));
d644 2
a645 2
  if (status) {
    wcserr_set(SPC_ERRMSG(status));
d663 1
a663 1
  return spctype(
d667 1
a667 3
/*--------------------------------------------------------------------------*/

int spctype(
d676 1
a676 1
  struct wcserr **err)
a678 2
  static const char *function = "spctype";

d735 2
a736 1
    return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
d745 2
a746 1
      return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
d753 2
a754 1
    return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
d763 2
a764 1
      return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
d776 2
a777 1
      return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
d783 2
a784 1
    return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
d788 3
a790 3
    return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
      "In spectral type '%s', P- and S-type variables are inconsistent",
      ctype);
d809 2
a810 1
    return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
d845 2
a846 2
  return spcspxe(ctypeS, crvalS, restfrq, restwav, ptype, xtype, restreq,
                 crvalX, dXdS, 0x0);
d849 1
a849 3
/*--------------------------------------------------------------------------*/

int spcspxe(
d859 1
a859 1
  struct wcserr **err)
a861 2
  static const char *function = "spcspxe";

a866 1

d868 2
a869 2
  if ((status = spctype(ctypeS, stype, scode, 0x0, 0x0, ptype, xtype, restreq,
                        err))) {
d875 2
a876 1
    return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
d882 2
a883 1
    return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
a888 1
  spx.err = (err ? *err : 0x0);
d890 3
a892 7
    status = SPCERR_BAD_SPEC_PARAMS;
    if (err) {
      (*err)->status = status;
    } else {
      free(spx.err);
    }
    return status;
d1009 2
a1010 2
  return spcxpse(ctypeS, crvalX, restfrq, restwav, ptype, xtype, restreq,
                 crvalS, dSdX, NULL);
d1013 1
a1013 3
/*--------------------------------------------------------------------------*/

int spcxpse(
d1023 1
a1023 1
  struct wcserr **err)
a1025 2
  static const char *function = "spcxpse";

d1032 2
a1033 2
  if ((status = spctype(ctypeS, stype, scode, 0x0, 0x0, ptype, xtype, restreq,
                        err))) {
d1039 2
a1040 1
    return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
d1046 2
a1047 1
    return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
d1062 4
a1065 9
  spx.err = (err ? *err : 0x0);
  if (specx(type, crvalX, restfrq, restwav, &spx)) {
    status = SPCERR_BAD_SPEC_PARAMS;
    if (err) {
      (*err)->status = status;
    } else {
      free(spx.err);
    }
    return status;
d1176 2
a1177 2
  return spctrne(ctypeS1, crvalS1, cdeltS1, restfrq, restwav,
                 ctypeS2, crvalS2, cdeltS2, NULL);
d1180 1
a1180 3
/*--------------------------------------------------------------------------*/

int spctrne(
d1189 1
a1189 1
  struct wcserr **err)
a1191 2
  static const char *function = "spctrne";

d1196 2
a1197 2
  if ((status = spcspxe(ctypeS1, crvalS1, restfrq, restwav, &ptype1, &xtype1,
                        &restreq, &crvalX, &dXdS1, err))) {
d1218 2
a1219 2
  if ((status = spcxpse(ctypeS2, crvalX, restfrq, restwav, &ptype2, &xtype2,
                        &restreq, crvalS2, &dS2dX, err))) {
d1225 2
a1226 1
    return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
@


4.7.1.4
log
@Trivia.
@
text
@d31 1
a31 1
  $Id: spc.c,v 4.7.1.3 2011/08/09 02:43:50 cal103 Exp cal103 $
d705 1
a705 1
/* : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : :  */
d884 1
a884 1
/* : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : :  */
d1056 1
a1056 1
/* : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : :  */
d1230 1
a1230 1
/* : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : :  */
@


4.7.1.5
log
@Use the WCSPRINTF_PTR() macro for printing addresses.
@
text
@d31 1
a31 1
  $Id: spc.c,v 4.7.1.4 2011/08/10 04:35:07 cal103 Exp cal103 $
d196 1
a196 1
  WCSPRINTF_PTR("        err: ", spc->err, "\n");
@


4.7.1.6
log
@Bug fix in spcaips(), it mishandled AIPS-convention CTYPEn without
Doppler frame.
@
text
@d31 1
a31 1
  $Id: spc.c,v 4.7.1.5 2011/08/12 05:42:29 cal103 Exp cal103 $
d1321 1
a1321 1
    if (*(fcode = ctype+4)) {
@


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: spc.c,v 4.5.1.1 2010/07/16 07:05:31 cal103 Exp cal103 $
d39 1
d123 3
a125 3
  printf("       flag: %d\n", spc->flag);
  printf("       type: \"%s\"\n", spc->type);
  printf("       code: \"%s\"\n", spc->code);
d127 1
a127 1
    printf("      crval: UNDEFINED\n");
d129 1
a129 1
    printf("      crval: %- 11.4g\n", spc->crval);
d131 2
a132 2
  printf("    restfrq: %f\n", spc->restfrq);
  printf("    restwav: %f\n", spc->restwav);
d134 1
a134 1
  printf("         pv:");
d138 1
a138 1
        printf("  UNDEFINED   ");
d140 1
a140 1
        printf("  %- 11.4g", spc->pv[i]);
d143 1
a143 1
    printf("\n            ");
d146 1
a146 1
        printf("  UNDEFINED   ");
d148 1
a148 1
        printf("  %- 11.4g", spc->pv[i]);
d151 1
a151 1
    printf("\n");
d154 1
a154 1
    printf(" (not used)\n");
d157 1
a157 1
  printf("          w:");
d159 1
a159 1
    printf("  %- 11.4g", spc->w[i]);
d162 1
a162 1
    printf("\n            ");
d164 1
a164 1
      printf("  %- 11.4g", spc->w[i]);
d166 1
a166 1
    printf("\n");
d168 1
a168 1
    printf("  (remainder unused)\n");
d171 5
a175 5
  printf("    isGrism: %d\n", spc->isGrism);
  printf("     spxX2P: %p\n", (void *)spc->spxX2P);
  printf("     spxP2S: %p\n", (void *)spc->spxP2S);
  printf("     spxS2P: %p\n", (void *)spc->spxS2P);
  printf("     spxP2X: %p\n", (void *)spc->spxP2X);
@


4.6.1.1
log
@WCSLIB 4.6 development branch.
@
text
@d31 1
a31 1
  $Id: spc.c,v 4.6 2010/11/16 06:15:31 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: spc.c,v 4.6.1.1 2010/11/16 06:16:19 cal103 Exp cal103 $
@


4.6.1.3
log
@Replaced calls to printf() with wcsprintf().
@
text
@d31 1
a31 1
  $Id: spc.c,v 4.6.1.2 2011/01/14 06:33:16 cal103 Exp cal103 $
a38 1
#include "wcsprintf.h"
d122 3
a124 3
  wcsprintf("       flag: %d\n", spc->flag);
  wcsprintf("       type: \"%s\"\n", spc->type);
  wcsprintf("       code: \"%s\"\n", spc->code);
d126 1
a126 1
    wcsprintf("      crval: UNDEFINED\n");
d128 1
a128 1
    wcsprintf("      crval: %- 11.4g\n", spc->crval);
d130 2
a131 2
  wcsprintf("    restfrq: %f\n", spc->restfrq);
  wcsprintf("    restwav: %f\n", spc->restwav);
d133 1
a133 1
  wcsprintf("         pv:");
d137 1
a137 1
        wcsprintf("  UNDEFINED   ");
d139 1
a139 1
        wcsprintf("  %- 11.4g", spc->pv[i]);
d142 1
a142 1
    wcsprintf("\n            ");
d145 1
a145 1
        wcsprintf("  UNDEFINED   ");
d147 1
a147 1
        wcsprintf("  %- 11.4g", spc->pv[i]);
d150 1
a150 1
    wcsprintf("\n");
d153 1
a153 1
    wcsprintf(" (not used)\n");
d156 1
a156 1
  wcsprintf("          w:");
d158 1
a158 1
    wcsprintf("  %- 11.4g", spc->w[i]);
d161 1
a161 1
    wcsprintf("\n            ");
d163 1
a163 1
      wcsprintf("  %- 11.4g", spc->w[i]);
d165 1
a165 1
    wcsprintf("\n");
d167 1
a167 1
    wcsprintf("  (remainder unused)\n");
d170 5
a174 5
  wcsprintf("    isGrism: %d\n", spc->isGrism);
  wcsprintf("     spxX2P: %p\n", (void *)spc->spxX2P);
  wcsprintf("     spxP2S: %p\n", (void *)spc->spxP2S);
  wcsprintf("     spxS2P: %p\n", (void *)spc->spxS2P);
  wcsprintf("     spxP2X: %p\n", (void *)spc->spxP2X);
@


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: spc.c,v 4.4.1.5 2010/07/09 07:57:14 cal103 Exp cal103 $
@


4.5.1.1
log
@WCSLIB 4.5 development branch.
@
text
@d31 1
a31 1
  $Id: spc.c,v 4.5 2010/07/16 07:01:25 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: spc.c,v 4.3.1.3 2009/07/22 04:28:39 cal103 Exp cal103 $
d40 1
d640 1
a640 1
  sprintf(ctype, "%-8s", ctypei);
a642 15
  /* Do alias translation for AIPS spectral types. */
  if (ctype[4] == '-') {
    if (strcmp(ctype+5, "LSR") == 0 ||
        strcmp(ctype+5, "HEL") == 0 ||
        strcmp(ctype+5, "OBS") == 0) {
      if (strncmp(ctype, "FREQ", 4) == 0 ||
          strncmp(ctype, "VELO", 4) == 0) {
        strcpy(ctype+4, "    ");
      } else if (strncmp(ctype, "FELO", 4) == 0) {
        strcpy(ctype, "VOPT-F2W");
      }
    }
  }


d658 1
a658 1
    strcpy(units_t, "1/m");
d1118 68
@


4.4.1.1
log
@WCSLIB 4.4 development branch.
@
text
@d31 1
a31 1
  $Id: spc.c,v 4.4 2009/08/06 07:41:33 cal103 Exp $
@


4.4.1.2
log
@Strictly speaking, the units of wavenumber are "/m", not "1/m" in
spctyp().
@
text
@d31 1
a31 1
  $Id: spc.c,v 4.4.1.1 2009/08/10 08:52:49 cal103 Exp cal103 $
d672 1
a672 1
    strcpy(units_t, "/m");
@


4.4.1.3
log
@Updated date in copyright notice.
@
text
@d4 1
a4 1
  Copyright (C) 1995-2010, Mark Calabretta
d31 1
a31 1
  $Id: spc.c,v 4.4.1.2 2009/09/03 02:32:44 cal103 Exp cal103 $
@


4.4.1.4
log
@Alias translation of AIPS spectral types, formerly in spctyp(), is now
handled by a special-purpose function, spcaips(), which also takes
account of VELREF.
@
text
@d31 1
a31 1
  $Id: spc.c,v 4.4.1.3 2010/01/19 03:42:50 cal103 Exp cal103 $
a39 1
#include "wcsutil.h"
d639 1
a639 1
  sprintf(ctype, "%-8.8s", ctypei);
d642 15
a1131 66

/*--------------------------------------------------------------------------*/

int spcaips(
  const char ctypeA[9],
  int  velref,
  char ctype[9],
  char specsys[9])

{
  const char *frames[] = {"LSRK", "BARYCENT", "TOPOCENT",
                          "LSRD", "GEOCENTR", "SOURCE", "GALACTOC"};
  char *fcode;
  int  aipsig = 0, ivf;

  /* Make a null-filled copy of ctypeA. */
  strncpy(ctype, ctypeA, 8);
  ctype[8] = '\0';
  wcsutil_null_fill(9, ctype);
  *specsys = '\0';

  /* Is it a recognized AIPS-convention type? */
  if (strncmp(ctype, "FREQ", 4) == 0 ||
      strncmp(ctype, "VELO", 4) == 0 ||
      strncmp(ctype, "FELO", 4) == 0) {
    /* Look for the Doppler frame. */
    if ((fcode = ctype+4)) {
      if (strcmp(fcode, "-LSR") == 0) {
        strcpy(specsys, "LSRK");
      } else if (strcmp(fcode, "-HEL") == 0) {
        strcpy(specsys, "BARYCENT");
      } else if (strcmp(fcode, "-OBS") == 0) {
        strcpy(specsys, "TOPOCENT");
      } else {
        /* Not a recognized AIPS spectral type. */
        return -1;
      }

      *fcode = '\0';
    }

    /* VELREF takes precedence if present. */
    ivf = velref%256;
    if (1 <= ivf && ivf <= 7) {
      strcpy(specsys, frames[ivf-1]);
    }
  }

  if (strcmp(ctype, "VELO") == 0) {
    /* Check that we found an AIPS-convention Doppler frame. */
    if (*specsys) {
      /* 'VELO' in AIPS means radio or optical depending on VELREF. */
      if (velref&256) {
        strcpy(ctype, "VRAD");
      } else {
        strcpy(ctype, "VOPT");
      }
    }
  } else if (strcmp(ctype, "FELO") == 0) {
    /* Uniform in frequency but expressed as an optical velocity (strictly
       we should also have found an AIPS-convention Doppler frame). */
    strcpy(ctype, "VOPT-F2W");
  }

  return 0;
}
@


4.4.1.5
log
@Couple of minor fixes to spcaips().
@
text
@d31 1
a31 1
  $Id: spc.c,v 4.4.1.4 2010/07/07 13:16:25 cal103 Exp cal103 $
d1131 1
a1131 1
  int  ivf;
d1134 1
a1134 1
  if (ctype != ctypeA) strncpy(ctype, ctypeA, 8);
d1164 1
d1166 8
a1173 9
    if (strcmp(ctype, "VELO") == 0) {
      /* Check that we found an AIPS-convention Doppler frame. */
      if (*specsys) {
        /* 'VELO' in AIPS means radio or optical depending on VELREF. */
        if (velref&256) {
          strcpy(ctype, "VRAD");
        } else {
          strcpy(ctype, "VOPT");
        }
a1174 4
    } else if (strcmp(ctype, "FELO") == 0) {
      /* Uniform in frequency but expressed as an optical velocity (strictly
         we should also have found an AIPS-convention Doppler frame). */
      strcpy(ctype, "VOPT-F2W");
d1176 4
a1179 2

    return 0;
d1182 1
a1182 1
  return -1;
@


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 24
a31 24
    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/>.

    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

    Author: Mark Calabretta, Australia Telescope National Facility
    http://www.atnf.csiro.au/~mcalabre/index.html
    $Id: spc.c,v 4.2.1.6 2007/12/03 05:02:17 cal103 Exp cal103 $
d67 5
a71 5
   "Success",
   "Null spcprm pointer passed",
   "Invalid spectral parameters",
   "One or more of x coordinates were invalid",
   "One or more of the spec coordinates were invalid"};
d81 1
a81 1
   register int k;
d83 1
a83 1
   if (spc == 0x0) return 1;
d85 1
a85 1
   spc->flag = 0;
d87 2
a88 2
   strcpy(spc->type, "    ");
   strcpy(spc->code, "   ");
d90 3
a92 3
   spc->crval = UNDEFINED;
   spc->restfrq =  0.0;
   spc->restwav =  0.0;
d94 3
a96 3
   for (k = 0; k < 7; k++) {
      spc->pv[k] = UNDEFINED;
   }
d98 3
a100 3
   for (k = 0; k < 6; k++) {
     spc->w[k] = 0.0;
   }
d102 1
a102 1
   spc->isGrism = 0;
d104 4
a107 4
   spc->spxX2P = 0x0;
   spc->spxP2S = 0x0;
   spc->spxS2P = 0x0;
   spc->spxP2X = 0x0;
d109 1
a109 1
   return 0;
d117 1
a117 1
   int i;
d119 1
a119 1
   if (spc == 0x0) return 1;
d121 18
a138 19
   printf("       flag: %d\n", spc->flag);
   printf("       type: \"%s\"\n", spc->type);
   printf("       code: \"%s\"\n", spc->code);
   if (undefined(spc->crval)) {
      printf("      crval: UNDEFINED\n");
   } else {
      printf("      crval: %- 11.4g\n", spc->crval);
   }
   printf("    restfrq: %f\n", spc->restfrq);
   printf("    restwav: %f\n", spc->restwav);

   printf("         pv:");
   if (spc->isGrism) {
      for (i = 0; i < 5; i++) {
         if (undefined(spc->pv[i])) {
            printf("  UNDEFINED   ");
         } else {
            printf("  %- 11.4g", spc->pv[i]);
         }
d140 7
a146 7
      printf("\n            ");
      for (i = 5; i < 7; i++) {
         if (undefined(spc->pv[i])) {
            printf("  UNDEFINED   ");
         } else {
            printf("  %- 11.4g", spc->pv[i]);
         }
d148 2
a149 1
      printf("\n");
d151 11
a161 6
   } else {
      printf(" (not used)\n");
   }

   printf("          w:");
   for (i = 0; i < 3; i++) {
d163 11
a173 16
   }
   if (spc->isGrism) {
      printf("\n            ");
      for (i = 3; i < 6; i++) {
         printf("  %- 11.4g", spc->w[i]);
      }
      printf("\n");
   } else {
      printf("  (remainder unused)\n");
   }

   printf("    isGrism: %d\n", spc->isGrism);
   printf("     spxX2P: %p\n", (void *)spc->spxX2P);
   printf("     spxP2S: %p\n", (void *)spc->spxP2S);
   printf("     spxS2P: %p\n", (void *)spc->spxS2P);
   printf("     spxP2X: %p\n", (void *)spc->spxP2X);
d175 1
a175 1
   return 0;
d183 47
a229 179
   char   ctype[9], ptype, xtype;
   int    restreq, status;
   double alpha, beta_r, crvalX, dn_r, dXdS, epsilon, G, m, lambda_r, n_r,
          t, restfrq, restwav, theta;

   if (spc == 0x0) return 1;

   if (undefined(spc->crval)) {
      return 2;
   }

   spc->type[4] = '\0';
   spc->code[3] = '\0';
   spc->w[0] = 0.0;


   /* Analyse the spectral axis type. */
   sprintf(ctype, "%s-%s", spc->type, spc->code);
   restfrq = spc->restfrq;
   restwav = spc->restwav;
   if ((status = spcspx(ctype, spc->crval, restfrq, restwav, &ptype, &xtype,
                        &restreq, &crvalX, &dXdS))) {
      return status;
   }

   /* Satisfy rest frequency/wavelength requirements. */
   if (restreq) {
      if (restreq == 3 && restfrq == 0.0 && restwav == 0.0) {
         /* VRAD-V2F, VOPT-V2W, and ZOPT-V2W require the rest frequency or */
         /* wavelength for the S-P and P-X transformations but not for S-X */
         /* so supply a phoney value. */
         restwav = 1.0;
      }

      if (restfrq == 0.0) {
         restfrq = C/restwav;
      } else {
         restwav = C/restfrq;
      }

      if (ptype == 'F') {
         spc->w[0] = restfrq;
      } else if (ptype != 'V') {
         spc->w[0] = restwav;
      } else {
         if (xtype == 'F') {
            spc->w[0] = restfrq;
         } else {
            spc->w[0] = restwav;
         }
      }
   }

   spc->w[1] = crvalX;
   spc->w[2] = dXdS;


   /* Set pointers-to-functions for the linear part of the transformation. */
   if (ptype == 'F') {
      if (strcmp(spc->type, "FREQ") == 0) {
         /* Frequency. */
         spc->flag = FREQ;
         spc->spxP2S = 0x0;
         spc->spxS2P = 0x0;

      } else if (strcmp(spc->type, "AFRQ") == 0) {
         /* Angular frequency. */
         spc->flag = AFRQ;
         spc->spxP2S = freqafrq;
         spc->spxS2P = afrqfreq;

      } else if (strcmp(spc->type, "ENER") == 0) {
         /* Photon energy. */
         spc->flag = ENER;
         spc->spxP2S = freqener;
         spc->spxS2P = enerfreq;

      } else if (strcmp(spc->type, "WAVN") == 0) {
         /* Wave number. */
         spc->flag = WAVN;
         spc->spxP2S = freqwavn;
         spc->spxS2P = wavnfreq;

      } else if (strcmp(spc->type, "VRAD") == 0) {
         /* Radio velocity. */
         spc->flag = VRAD;
         spc->spxP2S = freqvrad;
         spc->spxS2P = vradfreq;
      }

   } else if (ptype == 'W') {
      if (strcmp(spc->type, "WAVE") == 0) {
         /* Vacuum wavelengths. */
         spc->flag = WAVE;
         spc->spxP2S = 0x0;
         spc->spxS2P = 0x0;

      } else if (strcmp(spc->type, "VOPT") == 0) {
         /* Optical velocity. */
         spc->flag = VOPT;
         spc->spxP2S = wavevopt;
         spc->spxS2P = voptwave;

      } else if (strcmp(spc->type, "ZOPT") == 0) {
         /* Redshift. */
         spc->flag = ZOPT;
         spc->spxP2S = wavezopt;
         spc->spxS2P = zoptwave;
      }

   } else if (ptype == 'A') {
      if (strcmp(spc->type, "AWAV") == 0) {
         /* Air wavelengths. */
         spc->flag = AWAV;
         spc->spxP2S = 0x0;
         spc->spxS2P = 0x0;
      }

   } else if (ptype == 'V') {
      if (strcmp(spc->type, "VELO") == 0) {
         /* Relativistic velocity. */
         spc->flag = VELO;
         spc->spxP2S = 0x0;
         spc->spxS2P = 0x0;

      } else if (strcmp(spc->type, "BETA") == 0) {
         /* Velocity ratio (v/c). */
         spc->flag = BETA;
         spc->spxP2S = velobeta;
         spc->spxS2P = betavelo;
      }
   }


   /* Set pointers-to-functions for the non-linear part of the spectral */
   /* transformation.                                                   */
   spc->isGrism = 0;
   if (xtype == 'F') {
      /* Axis is linear in frequency. */
      if (ptype == 'F') {
         spc->spxX2P = 0x0;
         spc->spxP2X = 0x0;

      } else if (ptype == 'W') {
         spc->spxX2P = freqwave;
         spc->spxP2X = wavefreq;

      } else if (ptype == 'A') {
         spc->spxX2P = freqawav;
         spc->spxP2X = awavfreq;

      } else if (ptype == 'V') {
         spc->spxX2P = freqvelo;
         spc->spxP2X = velofreq;
      }

      spc->flag += F2S;

   } else if (xtype == 'W' || xtype == 'w') {
      /* Axis is linear in vacuum wavelengths. */
      if (ptype == 'F') {
         spc->spxX2P = wavefreq;
         spc->spxP2X = freqwave;

      } else if (ptype == 'W') {
         spc->spxX2P = 0x0;
         spc->spxP2X = 0x0;

      } else if (ptype == 'A') {
         spc->spxX2P = waveawav;
         spc->spxP2X = awavwave;

      } else if (ptype == 'V') {
         spc->spxX2P = wavevelo;
         spc->spxP2X = velowave;
      }

      if (xtype == 'W') {
         spc->flag += W2S;
d231 1
a231 3
         /* Grism in vacuum. */
         spc->isGrism = 1;
         spc->flag += GRI;
d233 2
d236 2
a237 26
   } else if (xtype == 'A' || xtype == 'a') {
      /* Axis is linear in air wavelengths. */
      if (ptype == 'F') {
         spc->spxX2P = awavfreq;
         spc->spxP2X = freqawav;

      } else if (ptype == 'W') {
         spc->spxX2P = awavwave;
         spc->spxP2X = waveawav;

      } else if (ptype == 'A') {
         spc->spxX2P = 0x0;
         spc->spxP2X = 0x0;

      } else if (ptype == 'V') {
         spc->spxX2P = awavvelo;
         spc->spxP2X = veloawav;
      }

      if (xtype == 'A') {
         spc->flag += A2S;
      } else {
         /* Grism in air. */
         spc->isGrism = 2;
         spc->flag += GRA;
      }
a238 21
   } else if (xtype == 'V') {
      /* Axis is linear in relativistic velocity. */
      if (ptype == 'F') {
         spc->spxX2P = velofreq;
         spc->spxP2X = freqvelo;

      } else if (ptype == 'W') {
         spc->spxX2P = velowave;
         spc->spxP2X = wavevelo;

      } else if (ptype == 'A') {
         spc->spxX2P = veloawav;
         spc->spxP2X = awavvelo;

      } else if (ptype == 'V') {
         spc->spxX2P = 0x0;
         spc->spxP2X = 0x0;
      }

      spc->flag += V2S;
   }
d240 212
a452 34
   /* Check for grism axes. */
   if (spc->isGrism) {
      /* Axis is linear in "grism parameter"; work in wavelength. */
      lambda_r = crvalX;

      /* Set defaults. */
      if (undefined(spc->pv[0])) spc->pv[0] = 0.0;
      if (undefined(spc->pv[1])) spc->pv[1] = 0.0;
      if (undefined(spc->pv[2])) spc->pv[2] = 0.0;
      if (undefined(spc->pv[3])) spc->pv[3] = 1.0;
      if (undefined(spc->pv[4])) spc->pv[4] = 0.0;
      if (undefined(spc->pv[5])) spc->pv[5] = 0.0;
      if (undefined(spc->pv[6])) spc->pv[6] = 0.0;

      /* Compute intermediaries. */
      G       = spc->pv[0];
      m       = spc->pv[1];
      alpha   = spc->pv[2];
      n_r     = spc->pv[3];
      dn_r    = spc->pv[4];
      epsilon = spc->pv[5];
      theta   = spc->pv[6];

      t = G*m/cosd(epsilon);
      beta_r = asind(t*lambda_r - n_r*sind(alpha));

      t -= dn_r*sind(alpha);

      spc->w[1] = -tand(theta);
      spc->w[2] *= t / (cosd(beta_r)*cosd(theta)*cosd(theta));
      spc->w[3] = beta_r + theta;
      spc->w[4] = (n_r - dn_r*lambda_r)*sind(alpha);
      spc->w[5] = 1.0 / t;
   }
d454 1
a454 2

   return 0;
d460 7
a466 7
   struct spcprm *spc,
   int nx,
   int sx,
   int sspec,
   const double x[],
   double spec[],
   int stat[])
d469 41
a509 29
   int statP2S, status = 0, statX2P;
   double beta;
   register int ix;
   register int *statp;
   register const double *xp;
   register double *specp;


   /* Initialize. */
   if (spc == 0x0) return 1;
   if (spc->flag == 0) {
      if (spcset(spc)) return 2;
   }

   /* Convert intermediate world coordinate x to X. */
   xp = x;
   specp = spec;
   statp = stat;
   for (ix = 0; ix < nx; ix++, xp += sx, specp += sspec) {
      *specp = spc->w[1] + (*xp)*spc->w[2];
      *(statp++) = 0;
   }

   /* If X is the grism parameter then convert it to wavelength. */
   if (spc->isGrism) {
      specp = spec;
      for (ix = 0; ix < nx; ix++, specp += sspec) {
         beta = atand(*specp) + spc->w[3];
         *specp = (sind(beta) + spc->w[4]) * spc->w[5];
d511 2
a512 1
   }
d514 9
a522 23
   /* Apply the non-linear step of the algorithm chain to convert the    */
   /* X-type spectral variable to P-type intermediate spectral variable. */
   if (spc->spxX2P) {
      if ((statX2P = spc->spxX2P(spc->w[0], nx, sspec, sspec, spec, spec,
                                 stat))) {
         if (statX2P == 4) {
            status = 3;
         } else {
            return statX2P;
         }
      }
   }

   /* Apply the linear step of the algorithm chain to convert P-type  */
   /* intermediate spectral variable to the required S-type variable. */
   if (spc->spxP2S) {
      if ((statP2S = spc->spxP2S(spc->w[0], nx, sspec, sspec, spec, spec,
                                 stat))) {
         if (statP2S == 4) {
            status = 3;
         } else {
            return statP2S;
         }
d524 2
a525 1
   }
d527 1
a527 1
   return status;
d533 7
a539 7
   struct spcprm *spc,
   int nspec,
   int sspec,
   int sx,
   const double spec[],
   double x[],
   int stat[])
d542 22
a563 24
   int statP2X, status = 0, statS2P;
   double beta, s;
   register int ispec;
   register int *statp;
   register const double *specp;
   register double *xp;


   /* Initialize. */
   if (spc == 0x0) return 1;
   if (spc->flag == 0) {
      if (spcset(spc)) return 2;
   }

   /* Apply the linear step of the algorithm chain to convert the S-type */
   /* spectral variable to P-type intermediate spectral variable.        */
   if (spc->spxS2P) {
      if ((statS2P = spc->spxS2P(spc->w[0], nspec, sspec, sx, spec, x,
                                 stat))) {
         if (statS2P == 4) {
            status = 4;
         } else {
            return statS2P;
         }
d565 1
d567 10
a576 10
   } else {
      /* Just a copy. */
      xp = x;
      specp = spec;
      statp = stat;
      for (ispec = 0; ispec < nspec; ispec++, specp += sspec, xp += sx) {
         *xp = *specp;
         *(statp++) = 0;
      }
   }
d579 8
a586 9
   /* Apply the non-linear step of the algorithm chain to convert P-type */
   /* intermediate spectral variable to X-type spectral variable. */
   if (spc->spxP2X) {
      if ((statP2X = spc->spxP2X(spc->w[0], nspec, sx, sx, x, x, stat))) {
         if (statP2X == 4) {
            status = 4;
         } else {
            return statP2X;
         }
d588 2
a589 1
   }
d591 13
a603 14
   if (spc->isGrism) {
      /* Convert X-type spectral variable (wavelength) to grism parameter. */
      xp = x;
      statp = stat;
      for (ispec = 0; ispec < nspec; ispec++, xp += sx, statp++) {
         if (*statp) continue;

         s = *xp/spc->w[5] - spc->w[4];
         if (fabs(s) <= 1.0) {
            beta = asind(s);
            *xp = tand(beta - spc->w[3]);
         } else {
            *statp = 1;
         }
d605 2
a606 1
   }
d609 5
a613 5
   /* Convert X-type spectral variable to intermediate world coordinate x. */
   xp = x;
   statp = stat;
   for (ispec = 0; ispec < nspec; ispec++, xp += sx) {
      if (*(statp++)) continue;
d615 3
a617 3
      *xp -= spc->w[1];
      *xp /= spc->w[2];
   }
d619 1
a619 1
   return status;
d625 8
a632 8
   const char ctypei[9],
   char stype[],
   char scode[],
   char sname[],
   char units[],
   char *ptype,
   char *xtype,
   int  *restreq)
d635 2
a636 74
   char ctype[9], ptype_t, sname_t[32], units_t[8], xtype_t;
   int  restreq_t = 0;

   /* Copy with blank padding. */
   sprintf(ctype, "%-8s", ctypei);
   ctype[8] = '\0';

   /* Do alias translation for AIPS spectral types. */
   if (ctype[4] == '-') {
      if (strcmp(ctype+5, "LSR") == 0 ||
          strcmp(ctype+5, "HEL") == 0 ||
          strcmp(ctype+5, "OBS") == 0) {
         if (strncmp(ctype, "FREQ", 4) == 0 ||
             strncmp(ctype, "VELO", 4) == 0) {
            strcpy(ctype+4, "    ");
         } else if (strncmp(ctype, "FELO", 4) == 0) {
            strcpy(ctype, "VOPT-F2W");
         }
      }
   }


   /* Validate the S-type spectral variable. */
   if (strncmp(ctype, "FREQ", 4) == 0) {
      strcpy(sname_t, "Frequency");
      strcpy(units_t, "Hz");
      ptype_t = 'F';
   } else if (strncmp(ctype, "AFRQ", 4) == 0) {
      strcpy(sname_t, "Angular frequency");
      strcpy(units_t, "deg/s");
      ptype_t = 'F';
   } else if (strncmp(ctype, "ENER", 4) == 0) {
      strcpy(sname_t, "Photon energy");
      strcpy(units_t, "J");
      ptype_t = 'F';
   } else if (strncmp(ctype, "WAVN", 4) == 0) {
      strcpy(sname_t, "Wavenumber");
      strcpy(units_t, "1/m");
      ptype_t = 'F';
   } else if (strncmp(ctype, "VRAD", 4) == 0) {
      strcpy(sname_t, "Radio velocity");
      strcpy(units_t, "m/s");
      ptype_t = 'F';
      restreq_t = 1;
   } else if (strncmp(ctype, "WAVE", 4) == 0) {
      strcpy(sname_t, "Vacuum wavelength");
      strcpy(units_t, "m");
      ptype_t = 'W';
   } else if (strncmp(ctype, "VOPT", 4) == 0) {
      strcpy(sname_t, "Optical velocity");
      strcpy(units_t, "m/s");
      ptype_t = 'W';
      restreq_t = 1;
   } else if (strncmp(ctype, "ZOPT", 4) == 0) {
      strcpy(sname_t, "Redshift");
      strcpy(units_t, "");
      ptype_t = 'W';
      restreq_t = 1;
   } else if (strncmp(ctype, "AWAV", 4) == 0) {
      strcpy(sname_t, "Air wavelength");
      strcpy(units_t, "m");
      ptype_t = 'A';
   } else if (strncmp(ctype, "VELO", 4) == 0) {
      strcpy(sname_t, "Relativistic velocity");
      strcpy(units_t, "m/s");
      ptype_t = 'V';
   } else if (strncmp(ctype, "BETA", 4) == 0) {
      strcpy(sname_t, "Velocity ratio (v/c)");
      strcpy(units_t, "");
      ptype_t = 'V';
   } else {
      return 2;
   }

d638 76
a713 10
   /* Determine X-type and validate the spectral algorithm code. */
   if ((xtype_t = ctype[5]) == ' ') {
      /* The algorithm code must be completely blank. */
      if (strcmp(ctype+4, "    ") != 0) {
         return 2;
      }

      xtype_t = ptype_t;

   } else if (ctype[4] != '-') {
d715 1
d717 1
a717 8
   } else if (strcmp(ctype+5, "LOG") == 0 || strcmp(ctype+5, "TAB") == 0) {
      /* Logarithmic or tabular axis, not linear in any spectral type. */

   } else if (xtype_t == 'G') {
      /* Validate the algorithm code. */
      if (ctype[6] != 'R') {
         return 2;
      }
d719 2
a720 10
      /* Grism coordinates... */
      if (ctype[7] == 'I') {
         /* ...in vacuum. */
         xtype_t = 'w';
      } else if (ctype[7] == 'A') {
         /* ...in air. */
         xtype_t = 'a';
      } else {
         return 2;
      }
d722 2
a723 3
   } else if (ctype[6] != '2') {
      /* Algorithm code has invalid syntax. */
      return 2;
d725 3
a727 2
   } else if (ctype[7] != ptype_t && ctype[7] != '?') {
      /* The P-, and S-type variables are inconsistent. */
d729 1
d731 8
a738 17
   } else if (ctype[7] == ctype[5]) {
      /* Degenerate algorithm code. */
      sprintf(ctype+4, "    ");
   }


   /* Rest freq/wavelength required for transformation between P and X? */
   if (strchr("FWAwa", (int)xtype_t)) {
      if (ptype_t == 'V') {
         restreq_t += 2;
      }
   } else if (xtype_t == 'V') {
      if (strchr("FWAwa", (int)ptype_t)) {
         restreq_t += 2;
      }
   } else if (strchr("LT", (int)xtype_t) == 0) {
      /* Invalid X-type variable code. */
d740 1
a740 1
   }
d742 40
a782 11
   /* Copy results. */
   if (stype) {
      strncpy(stype, ctype, 4);
      stype[4] = '\0';
   }
   if (scode) strcpy(scode, ctype+5);
   if (sname) strcpy(sname, sname_t);
   if (units) strcpy(units, units_t);
   if (ptype) *ptype = ptype_t;
   if (xtype) *xtype = xtype_t;
   if (restreq) *restreq = restreq_t;
d784 1
a784 2

   return 0;
d790 9
a798 9
   const char ctypeS[9],
   double crvalS,
   double restfrq,
   double restwav,
   char *ptype,
   char *xtype,
   int *restreq,
   double *crvalX,
   double *dXdS)
d801 120
a920 42
   char scode[4], stype[5], type[8];
   int  status;
   double dPdS, dXdP;
   struct spxprm spx;

   /* Analyse the spectral axis code. */
   if (spctyp(ctypeS, stype, scode, 0x0, 0x0, ptype, xtype, restreq)) {
      return 2;
   }

   if (strstr("LT", xtype)) {
      /* Can't handle logarithmic or tabular coordinates. */
      return 2;
   }

   /* Do we have rest frequency and/or wavelength as required? */
   if ((*restreq)%3 && restfrq == 0.0 && restwav == 0.0) {
      return 2;
   }

   /* Compute all spectral parameters and their derivatives. */
   strcpy(type, stype);
   if ((status = specx(type, crvalS, restfrq, restwav, &spx))) {
      return 2;
   }


   /* Transform S-P (linear) and P-X (non-linear). */
   dPdS = 0.0;
   dXdP = 0.0;
   if (*ptype == 'F') {
      if (strcmp(stype, "FREQ") == 0) {
         dPdS = 1.0;
      } else if (strcmp(stype, "AFRQ") == 0) {
         dPdS = spx.dfreqafrq;
      } else if (strcmp(stype, "ENER") == 0) {
         dPdS = spx.dfreqener;
      } else if (strcmp(stype, "WAVN") == 0) {
         dPdS = spx.dfreqwavn;
      } else if (strcmp(stype, "VRAD") == 0) {
         dPdS = spx.dfreqvrad;
      }
d922 1
a922 79
      if (*xtype == 'F') {
         *crvalX = spx.freq;
         dXdP = 1.0;
      } else if (*xtype == 'W' || *xtype == 'w') {
         *crvalX = spx.wave;
         dXdP = spx.dwavefreq;
      } else if (*xtype == 'A' || *xtype == 'a') {
         *crvalX = spx.awav;
         dXdP = spx.dawavfreq;
      } else if (*xtype == 'V') {
         *crvalX = spx.velo;
         dXdP = spx.dvelofreq;
      }

   } else if (*ptype == 'W' || *ptype == 'w') {
      if (strcmp(stype, "WAVE") == 0) {
         dPdS = 1.0;
      } else if (strcmp(stype, "VOPT") == 0) {
         dPdS = spx.dwavevopt;
      } else if (strcmp(stype, "ZOPT") == 0) {
         dPdS = spx.dwavezopt;
      }

      if (*xtype == 'F') {
         *crvalX = spx.freq;
         dXdP = spx.dfreqwave;
      } else if (*xtype == 'W' || *xtype == 'w') {
         *crvalX = spx.wave;
         dXdP = 1.0;
      } else if (*xtype == 'A' || *xtype == 'a') {
         *crvalX = spx.awav;
         dXdP = spx.dawavwave;
      } else if (*xtype == 'V') {
         *crvalX = spx.velo;
         dXdP = spx.dvelowave;
      }

   } else if (*ptype == 'A' || *ptype == 'a') {
      if (strcmp(stype, "AWAV") == 0) {
         dPdS = 1.0;
      }

      if (*xtype == 'F') {
         *crvalX = spx.freq;
         dXdP = spx.dfreqawav;
      } else if (*xtype == 'W' || *xtype == 'w') {
         *crvalX = spx.wave;
         dXdP = spx.dwaveawav;
      } else if (*xtype == 'A' || *xtype == 'a') {
         *crvalX = spx.awav;
         dXdP = 1.0;
      } else if (*xtype == 'V') {
         *crvalX = spx.velo;
         dXdP = spx.dveloawav;
      }

   } else if (*ptype == 'V') {
      if (strcmp(stype, "VELO") == 0) {
         dPdS = 1.0;
      } else if (strcmp(stype, "BETA") == 0) {
         dPdS = spx.dvelobeta;
      }

      if (*xtype == 'F') {
         *crvalX = spx.freq;
         dXdP = spx.dfreqvelo;
      } else if (*xtype == 'W' || *xtype == 'w') {
         *crvalX = spx.wave;
         dXdP = spx.dwavevelo;
      } else if (*xtype == 'A' || *xtype == 'a') {
         *crvalX = spx.awav;
         dXdP = spx.dawavvelo;
      } else if (*xtype == 'V') {
         *crvalX = spx.velo;
         dXdP = 1.0;
      }
   }

   *dXdS = dXdP * dPdS;
d924 1
a924 1
   return 0;
d930 9
a938 9
   const char ctypeS[9],
   double crvalX,
   double restfrq,
   double restwav,
   char *ptype,
   char *xtype,
   int *restreq,
   double *crvalS,
   double *dSdX)
d941 124
a1064 9
   char scode[4], stype[5], type[8];
   int  status;
   double dPdX, dSdP;
   struct spxprm spx;

   /* Analyse the spectral axis type. */
   if (spctyp(ctypeS, stype, scode, 0x0, 0x0, ptype, xtype, restreq)) {
      return 2;
   }
d1066 1
a1066 116
   if (strstr("LT", xtype)) {
      /* Can't handle logarithmic or tabular coordinates. */
      return 2;
   }

   /* Do we have rest frequency and/or wavelength as required? */
   if ((*restreq)%3 && restfrq == 0.0 && restwav == 0.0) {
      return 2;
   }

   /* Compute all spectral parameters and their derivatives. */
   if (*xtype == 'F') {
     strcpy(type, "FREQ");
   } else if (*xtype == 'W' || *xtype == 'w') {
     strcpy(type, "WAVE");
   } else if (*xtype == 'A' || *xtype == 'a') {
     strcpy(type, "AWAV");
   } else if (*xtype == 'V') {
     strcpy(type, "VELO");
   }

   if ((status = specx(type, crvalX, restfrq, restwav, &spx))) {
      return 2;
   }


   /* Transform X-P (non-linear) and P-S (linear). */
   dPdX = 0.0;
   dSdP = 0.0;
   if (*ptype == 'F') {
      if (*xtype == 'F') {
         dPdX = 1.0;
      } else if (*xtype == 'W' || *xtype == 'w') {
         dPdX = spx.dfreqwave;
      } else if (*xtype == 'A' || *xtype == 'a') {
         dPdX = spx.dfreqawav;
      } else if (*xtype == 'V') {
         dPdX = spx.dfreqvelo;
      }

      if (strcmp(stype, "FREQ") == 0) {
         *crvalS = spx.freq;
         dSdP = 1.0;
      } else if (strcmp(stype, "AFRQ") == 0) {
         *crvalS = spx.afrq;
         dSdP = spx.dafrqfreq;
      } else if (strcmp(stype, "ENER") == 0) {
         *crvalS = spx.ener;
         dSdP = spx.denerfreq;
      } else if (strcmp(stype, "WAVN") == 0) {
         *crvalS = spx.wavn;
         dSdP = spx.dwavnfreq;
      } else if (strcmp(stype, "VRAD") == 0) {
         *crvalS = spx.vrad;
         dSdP = spx.dvradfreq;
      }

   } else if (*ptype == 'W') {
      if (*xtype == 'F') {
         dPdX = spx.dwavefreq;
      } else if (*xtype == 'W' || *xtype == 'w') {
         dPdX = 1.0;
      } else if (*xtype == 'A' || *xtype == 'a') {
         dPdX = spx.dwaveawav;
      } else if (*xtype == 'V') {
         dPdX = spx.dwavevelo;
      }

      if (strcmp(stype, "WAVE") == 0) {
         *crvalS = spx.wave;
         dSdP = 1.0;
      } else if (strcmp(stype, "VOPT") == 0) {
         *crvalS = spx.vopt;
         dSdP = spx.dvoptwave;
      } else if (strcmp(stype, "ZOPT") == 0) {
         *crvalS = spx.zopt;
         dSdP = spx.dzoptwave;
      }

   } else if (*ptype == 'A') {
      if (*xtype == 'F') {
         dPdX = spx.dawavfreq;
      } else if (*xtype == 'W' || *xtype == 'w') {
         dPdX = spx.dawavwave;
      } else if (*xtype == 'A' || *xtype == 'a') {
         dPdX = 1.0;
      } else if (*xtype == 'V') {
         dPdX = spx.dawavvelo;
      }

      if (strcmp(stype, "AWAV") == 0) {
         *crvalS = spx.awav;
         dSdP = 1.0;
      }

   } else if (*ptype == 'V') {
      if (*xtype == 'F') {
         dPdX = spx.dvelofreq;
      } else if (*xtype == 'W' || *xtype == 'w') {
         dPdX = spx.dvelowave;
      } else if (*xtype == 'A' || *xtype == 'a') {
         dPdX = spx.dveloawav;
      } else if (*xtype == 'V') {
         dPdX = 1.0;
      }

      if (strcmp(stype, "VELO") == 0) {
         *crvalS = spx.velo;
         dSdP = 1.0;
      } else if (strcmp(stype, "BETA") == 0) {
         *crvalS = spx.beta;
         dSdP = spx.dbetavelo;
      }
   }

   *dSdX = dSdP * dPdX;
d1068 1
a1068 1
   return 0;
d1074 8
a1081 8
   const char ctypeS1[9],
   double crvalS1,
   double cdeltS1,
   double restfrq,
   double restwav,
   char   ctypeS2[9],
   double *crvalS2,
   double *cdeltS2)
d1084 43
a1126 43
   char *cp, ptype1, ptype2, xtype1, xtype2;
   int  restreq, status;
   double crvalX, dS2dX, dXdS1;

   if ((status = spcspx(ctypeS1, crvalS1, restfrq, restwav, &ptype1, &xtype1,
                        &restreq, &crvalX, &dXdS1))) {
      return status;
   }

   /* Blank fill. */
   ctypeS2[8] = '\0';
   for (cp = ctypeS2; *cp; cp++);
   while (cp < ctypeS2+8) *(cp++) = ' ';

   if (strncmp(ctypeS2+5, "???", 3) == 0) {
      /* Set the algorithm code if required. */
      if (xtype1 == 'w') {
         strcpy(ctypeS2+5, "GRI");
      } else if (xtype1 == 'a') {
         strcpy(ctypeS2+5, "GRA");
      } else {
         ctypeS2[5] = xtype1;
         ctypeS2[6] = '2';
      }
   }

   if ((status = spcxps(ctypeS2, crvalX, restfrq, restwav, &ptype2, &xtype2,
                        &restreq, crvalS2, &dS2dX))) {
      return status;
   }

   /* Are the X-types compatible? */
   if (xtype2 != xtype1) {
      return 2;
   }

   if (ctypeS2[7] == '?') {
      if (ptype2 == xtype2) {
        strcpy(ctypeS2+4, "    ");
      } else {
        ctypeS2[7] = ptype2;
      }
   }
d1128 1
a1128 1
   *cdeltS2 = dS2dX * dXdS1 * cdeltS1;
d1130 1
a1130 1
   return 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: spc.c,v 4.3 2007/12/27 05:41:36 cal103 Exp cal103 $
@


4.3.1.2
log
@Angular frequency is measured in rad/s, not deg/s.
@
text
@d31 1
a31 1
    $Id: spc.c,v 4.3.1.1 2007/12/27 13:23:47 cal103 Exp cal103 $
d665 1
a665 1
      strcpy(units_t, "rad/s");
@


4.3.1.3
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 24
a31 24
  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/>.

  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

  Author: Mark Calabretta, Australia Telescope National Facility
  http://www.atnf.csiro.au/~mcalabre/index.html
  $Id: spc.c,v 4.3.1.2 2008/10/08 07:49:16 cal103 Exp cal103 $
d67 5
a71 5
  "Success",
  "Null spcprm pointer passed",
  "Invalid spectral parameters",
  "One or more of x coordinates were invalid",
  "One or more of the spec coordinates were invalid"};
d81 1
a81 1
  register int k;
d83 1
a83 1
  if (spc == 0x0) return 1;
d85 1
a85 1
  spc->flag = 0;
d87 2
a88 2
  strcpy(spc->type, "    ");
  strcpy(spc->code, "   ");
d90 3
a92 3
  spc->crval = UNDEFINED;
  spc->restfrq =  0.0;
  spc->restwav =  0.0;
d94 3
a96 3
  for (k = 0; k < 7; k++) {
    spc->pv[k] = UNDEFINED;
  }
d98 3
a100 3
  for (k = 0; k < 6; k++) {
    spc->w[k] = 0.0;
  }
d102 1
a102 1
  spc->isGrism = 0;
d104 4
a107 4
  spc->spxX2P = 0x0;
  spc->spxP2S = 0x0;
  spc->spxS2P = 0x0;
  spc->spxP2X = 0x0;
d109 1
a109 1
  return 0;
d117 1
a117 1
  int i;
d119 1
a119 1
  if (spc == 0x0) return 1;
d121 19
a139 18
  printf("       flag: %d\n", spc->flag);
  printf("       type: \"%s\"\n", spc->type);
  printf("       code: \"%s\"\n", spc->code);
  if (undefined(spc->crval)) {
    printf("      crval: UNDEFINED\n");
  } else {
    printf("      crval: %- 11.4g\n", spc->crval);
  }
  printf("    restfrq: %f\n", spc->restfrq);
  printf("    restwav: %f\n", spc->restwav);

  printf("         pv:");
  if (spc->isGrism) {
    for (i = 0; i < 5; i++) {
      if (undefined(spc->pv[i])) {
        printf("  UNDEFINED   ");
      } else {
        printf("  %- 11.4g", spc->pv[i]);
d141 7
a147 7
    }
    printf("\n            ");
    for (i = 5; i < 7; i++) {
      if (undefined(spc->pv[i])) {
        printf("  UNDEFINED   ");
      } else {
        printf("  %- 11.4g", spc->pv[i]);
d149 1
a149 2
    }
    printf("\n");
d151 6
a156 11
  } else {
    printf(" (not used)\n");
  }

  printf("          w:");
  for (i = 0; i < 3; i++) {
    printf("  %- 11.4g", spc->w[i]);
  }
  if (spc->isGrism) {
    printf("\n            ");
    for (i = 3; i < 6; i++) {
d158 16
a173 11
    }
    printf("\n");
  } else {
    printf("  (remainder unused)\n");
  }

  printf("    isGrism: %d\n", spc->isGrism);
  printf("     spxX2P: %p\n", (void *)spc->spxX2P);
  printf("     spxP2S: %p\n", (void *)spc->spxP2S);
  printf("     spxS2P: %p\n", (void *)spc->spxS2P);
  printf("     spxP2X: %p\n", (void *)spc->spxP2X);
d175 1
a175 1
  return 0;
d183 179
a361 47
  char   ctype[9], ptype, xtype;
  int    restreq, status;
  double alpha, beta_r, crvalX, dn_r, dXdS, epsilon, G, m, lambda_r, n_r,
         t, restfrq, restwav, theta;

  if (spc == 0x0) return 1;

  if (undefined(spc->crval)) {
    return 2;
  }

  spc->type[4] = '\0';
  spc->code[3] = '\0';
  spc->w[0] = 0.0;


  /* Analyse the spectral axis type. */
  sprintf(ctype, "%s-%s", spc->type, spc->code);
  restfrq = spc->restfrq;
  restwav = spc->restwav;
  if ((status = spcspx(ctype, spc->crval, restfrq, restwav, &ptype, &xtype,
                       &restreq, &crvalX, &dXdS))) {
    return status;
  }

  /* Satisfy rest frequency/wavelength requirements. */
  if (restreq) {
    if (restreq == 3 && restfrq == 0.0 && restwav == 0.0) {
      /* VRAD-V2F, VOPT-V2W, and ZOPT-V2W require the rest frequency or */
      /* wavelength for the S-P and P-X transformations but not for S-X */
      /* so supply a phoney value. */
      restwav = 1.0;
    }

    if (restfrq == 0.0) {
      restfrq = C/restwav;
    } else {
      restwav = C/restfrq;
    }

    if (ptype == 'F') {
      spc->w[0] = restfrq;
    } else if (ptype != 'V') {
      spc->w[0] = restwav;
    } else {
      if (xtype == 'F') {
        spc->w[0] = restfrq;
d363 3
a365 1
        spc->w[0] = restwav;
a366 2
    }
  }
d368 26
a393 2
  spc->w[1] = crvalX;
  spc->w[2] = dXdS;
d395 21
a416 212
  /* Set pointers-to-functions for the linear part of the transformation. */
  if (ptype == 'F') {
    if (strcmp(spc->type, "FREQ") == 0) {
      /* Frequency. */
      spc->flag = FREQ;
      spc->spxP2S = 0x0;
      spc->spxS2P = 0x0;

    } else if (strcmp(spc->type, "AFRQ") == 0) {
      /* Angular frequency. */
      spc->flag = AFRQ;
      spc->spxP2S = freqafrq;
      spc->spxS2P = afrqfreq;

    } else if (strcmp(spc->type, "ENER") == 0) {
      /* Photon energy. */
      spc->flag = ENER;
      spc->spxP2S = freqener;
      spc->spxS2P = enerfreq;

    } else if (strcmp(spc->type, "WAVN") == 0) {
      /* Wave number. */
      spc->flag = WAVN;
      spc->spxP2S = freqwavn;
      spc->spxS2P = wavnfreq;

    } else if (strcmp(spc->type, "VRAD") == 0) {
      /* Radio velocity. */
      spc->flag = VRAD;
      spc->spxP2S = freqvrad;
      spc->spxS2P = vradfreq;
    }

  } else if (ptype == 'W') {
    if (strcmp(spc->type, "WAVE") == 0) {
      /* Vacuum wavelengths. */
      spc->flag = WAVE;
      spc->spxP2S = 0x0;
      spc->spxS2P = 0x0;

    } else if (strcmp(spc->type, "VOPT") == 0) {
      /* Optical velocity. */
      spc->flag = VOPT;
      spc->spxP2S = wavevopt;
      spc->spxS2P = voptwave;

    } else if (strcmp(spc->type, "ZOPT") == 0) {
      /* Redshift. */
      spc->flag = ZOPT;
      spc->spxP2S = wavezopt;
      spc->spxS2P = zoptwave;
    }

  } else if (ptype == 'A') {
    if (strcmp(spc->type, "AWAV") == 0) {
      /* Air wavelengths. */
      spc->flag = AWAV;
      spc->spxP2S = 0x0;
      spc->spxS2P = 0x0;
    }

  } else if (ptype == 'V') {
    if (strcmp(spc->type, "VELO") == 0) {
      /* Relativistic velocity. */
      spc->flag = VELO;
      spc->spxP2S = 0x0;
      spc->spxS2P = 0x0;

    } else if (strcmp(spc->type, "BETA") == 0) {
      /* Velocity ratio (v/c). */
      spc->flag = BETA;
      spc->spxP2S = velobeta;
      spc->spxS2P = betavelo;
    }
  }


  /* Set pointers-to-functions for the non-linear part of the spectral */
  /* transformation.                                                   */
  spc->isGrism = 0;
  if (xtype == 'F') {
    /* Axis is linear in frequency. */
    if (ptype == 'F') {
      spc->spxX2P = 0x0;
      spc->spxP2X = 0x0;

    } else if (ptype == 'W') {
      spc->spxX2P = freqwave;
      spc->spxP2X = wavefreq;

    } else if (ptype == 'A') {
      spc->spxX2P = freqawav;
      spc->spxP2X = awavfreq;

    } else if (ptype == 'V') {
      spc->spxX2P = freqvelo;
      spc->spxP2X = velofreq;
    }

    spc->flag += F2S;

  } else if (xtype == 'W' || xtype == 'w') {
    /* Axis is linear in vacuum wavelengths. */
    if (ptype == 'F') {
      spc->spxX2P = wavefreq;
      spc->spxP2X = freqwave;

    } else if (ptype == 'W') {
      spc->spxX2P = 0x0;
      spc->spxP2X = 0x0;

    } else if (ptype == 'A') {
      spc->spxX2P = waveawav;
      spc->spxP2X = awavwave;

    } else if (ptype == 'V') {
      spc->spxX2P = wavevelo;
      spc->spxP2X = velowave;
    }

    if (xtype == 'W') {
      spc->flag += W2S;
    } else {
      /* Grism in vacuum. */
      spc->isGrism = 1;
      spc->flag += GRI;
    }

  } else if (xtype == 'A' || xtype == 'a') {
    /* Axis is linear in air wavelengths. */
    if (ptype == 'F') {
      spc->spxX2P = awavfreq;
      spc->spxP2X = freqawav;

    } else if (ptype == 'W') {
      spc->spxX2P = awavwave;
      spc->spxP2X = waveawav;

    } else if (ptype == 'A') {
      spc->spxX2P = 0x0;
      spc->spxP2X = 0x0;

    } else if (ptype == 'V') {
      spc->spxX2P = awavvelo;
      spc->spxP2X = veloawav;
    }

    if (xtype == 'A') {
      spc->flag += A2S;
    } else {
      /* Grism in air. */
      spc->isGrism = 2;
      spc->flag += GRA;
    }

  } else if (xtype == 'V') {
    /* Axis is linear in relativistic velocity. */
    if (ptype == 'F') {
      spc->spxX2P = velofreq;
      spc->spxP2X = freqvelo;

    } else if (ptype == 'W') {
      spc->spxX2P = velowave;
      spc->spxP2X = wavevelo;

    } else if (ptype == 'A') {
      spc->spxX2P = veloawav;
      spc->spxP2X = awavvelo;

    } else if (ptype == 'V') {
      spc->spxX2P = 0x0;
      spc->spxP2X = 0x0;
    }

    spc->flag += V2S;
  }


  /* Check for grism axes. */
  if (spc->isGrism) {
    /* Axis is linear in "grism parameter"; work in wavelength. */
    lambda_r = crvalX;

    /* Set defaults. */
    if (undefined(spc->pv[0])) spc->pv[0] = 0.0;
    if (undefined(spc->pv[1])) spc->pv[1] = 0.0;
    if (undefined(spc->pv[2])) spc->pv[2] = 0.0;
    if (undefined(spc->pv[3])) spc->pv[3] = 1.0;
    if (undefined(spc->pv[4])) spc->pv[4] = 0.0;
    if (undefined(spc->pv[5])) spc->pv[5] = 0.0;
    if (undefined(spc->pv[6])) spc->pv[6] = 0.0;

    /* Compute intermediaries. */
    G       = spc->pv[0];
    m       = spc->pv[1];
    alpha   = spc->pv[2];
    n_r     = spc->pv[3];
    dn_r    = spc->pv[4];
    epsilon = spc->pv[5];
    theta   = spc->pv[6];

    t = G*m/cosd(epsilon);
    beta_r = asind(t*lambda_r - n_r*sind(alpha));

    t -= dn_r*sind(alpha);

    spc->w[1] = -tand(theta);
    spc->w[2] *= t / (cosd(beta_r)*cosd(theta)*cosd(theta));
    spc->w[3] = beta_r + theta;
    spc->w[4] = (n_r - dn_r*lambda_r)*sind(alpha);
    spc->w[5] = 1.0 / t;
  }
d418 34
d453 2
a454 1
  return 0;
d460 7
a466 7
  struct spcprm *spc,
  int nx,
  int sx,
  int sspec,
  const double x[],
  double spec[],
  int stat[])
d469 42
a510 41
  int statP2S, status = 0, statX2P;
  double beta;
  register int ix;
  register int *statp;
  register const double *xp;
  register double *specp;


  /* Initialize. */
  if (spc == 0x0) return 1;
  if (spc->flag == 0) {
    if (spcset(spc)) return 2;
  }

  /* Convert intermediate world coordinate x to X. */
  xp = x;
  specp = spec;
  statp = stat;
  for (ix = 0; ix < nx; ix++, xp += sx, specp += sspec) {
    *specp = spc->w[1] + (*xp)*spc->w[2];
    *(statp++) = 0;
  }

  /* If X is the grism parameter then convert it to wavelength. */
  if (spc->isGrism) {
    specp = spec;
    for (ix = 0; ix < nx; ix++, specp += sspec) {
      beta = atand(*specp) + spc->w[3];
      *specp = (sind(beta) + spc->w[4]) * spc->w[5];
    }
  }

  /* Apply the non-linear step of the algorithm chain to convert the    */
  /* X-type spectral variable to P-type intermediate spectral variable. */
  if (spc->spxX2P) {
    if ((statX2P = spc->spxX2P(spc->w[0], nx, sspec, sspec, spec, spec,
                               stat))) {
      if (statX2P == 4) {
        status = 3;
      } else {
        return statX2P;
d512 1
a512 2
    }
  }
d514 10
a523 9
  /* Apply the linear step of the algorithm chain to convert P-type  */
  /* intermediate spectral variable to the required S-type variable. */
  if (spc->spxP2S) {
    if ((statP2S = spc->spxP2S(spc->w[0], nx, sspec, sspec, spec, spec,
                               stat))) {
      if (statP2S == 4) {
        status = 3;
      } else {
        return statP2S;
d525 1
a525 2
    }
  }
d527 1
a527 1
  return status;
d533 7
a539 7
  struct spcprm *spc,
  int nspec,
  int sspec,
  int sx,
  const double spec[],
  double x[],
  int stat[])
d542 24
a565 22
  int statP2X, status = 0, statS2P;
  double beta, s;
  register int ispec;
  register int *statp;
  register const double *specp;
  register double *xp;


  /* Initialize. */
  if (spc == 0x0) return 1;
  if (spc->flag == 0) {
    if (spcset(spc)) return 2;
  }

  /* Apply the linear step of the algorithm chain to convert the S-type */
  /* spectral variable to P-type intermediate spectral variable.        */
  if (spc->spxS2P) {
    if ((statS2P = spc->spxS2P(spc->w[0], nspec, sspec, sx, spec, x, stat))) {
      if (statS2P == 4) {
        status = 4;
      } else {
        return statS2P;
a566 1
    }
d568 10
a577 10
  } else {
    /* Just a copy. */
    xp = x;
    specp = spec;
    statp = stat;
    for (ispec = 0; ispec < nspec; ispec++, specp += sspec, xp += sx) {
      *xp = *specp;
      *(statp++) = 0;
    }
  }
d580 9
a588 8
  /* Apply the non-linear step of the algorithm chain to convert P-type */
  /* intermediate spectral variable to X-type spectral variable. */
  if (spc->spxP2X) {
    if ((statP2X = spc->spxP2X(spc->w[0], nspec, sx, sx, x, x, stat))) {
      if (statP2X == 4) {
        status = 4;
      } else {
        return statP2X;
d590 1
a590 2
    }
  }
d592 14
a605 13
  if (spc->isGrism) {
    /* Convert X-type spectral variable (wavelength) to grism parameter. */
    xp = x;
    statp = stat;
    for (ispec = 0; ispec < nspec; ispec++, xp += sx, statp++) {
      if (*statp) continue;

      s = *xp/spc->w[5] - spc->w[4];
      if (fabs(s) <= 1.0) {
        beta = asind(s);
        *xp = tand(beta - spc->w[3]);
      } else {
        *statp = 1;
d607 1
a607 2
    }
  }
d610 5
a614 5
  /* Convert X-type spectral variable to intermediate world coordinate x. */
  xp = x;
  statp = stat;
  for (ispec = 0; ispec < nspec; ispec++, xp += sx) {
    if (*(statp++)) continue;
d616 3
a618 3
    *xp -= spc->w[1];
    *xp /= spc->w[2];
  }
d620 1
a620 1
  return status;
d626 8
a633 8
  const char ctypei[9],
  char stype[],
  char scode[],
  char sname[],
  char units[],
  char *ptype,
  char *xtype,
  int  *restreq)
d636 74
a709 2
  char ctype[9], ptype_t, sname_t[32], units_t[8], xtype_t;
  int  restreq_t = 0;
d711 10
a720 76
  /* Copy with blank padding. */
  sprintf(ctype, "%-8s", ctypei);
  ctype[8] = '\0';

  /* Do alias translation for AIPS spectral types. */
  if (ctype[4] == '-') {
    if (strcmp(ctype+5, "LSR") == 0 ||
        strcmp(ctype+5, "HEL") == 0 ||
        strcmp(ctype+5, "OBS") == 0) {
      if (strncmp(ctype, "FREQ", 4) == 0 ||
          strncmp(ctype, "VELO", 4) == 0) {
        strcpy(ctype+4, "    ");
      } else if (strncmp(ctype, "FELO", 4) == 0) {
        strcpy(ctype, "VOPT-F2W");
      }
    }
  }


  /* Validate the S-type spectral variable. */
  if (strncmp(ctype, "FREQ", 4) == 0) {
    strcpy(sname_t, "Frequency");
    strcpy(units_t, "Hz");
    ptype_t = 'F';
  } else if (strncmp(ctype, "AFRQ", 4) == 0) {
    strcpy(sname_t, "Angular frequency");
    strcpy(units_t, "rad/s");
    ptype_t = 'F';
  } else if (strncmp(ctype, "ENER", 4) == 0) {
    strcpy(sname_t, "Photon energy");
    strcpy(units_t, "J");
    ptype_t = 'F';
  } else if (strncmp(ctype, "WAVN", 4) == 0) {
    strcpy(sname_t, "Wavenumber");
    strcpy(units_t, "1/m");
    ptype_t = 'F';
  } else if (strncmp(ctype, "VRAD", 4) == 0) {
    strcpy(sname_t, "Radio velocity");
    strcpy(units_t, "m/s");
    ptype_t = 'F';
    restreq_t = 1;
  } else if (strncmp(ctype, "WAVE", 4) == 0) {
    strcpy(sname_t, "Vacuum wavelength");
    strcpy(units_t, "m");
    ptype_t = 'W';
  } else if (strncmp(ctype, "VOPT", 4) == 0) {
    strcpy(sname_t, "Optical velocity");
    strcpy(units_t, "m/s");
    ptype_t = 'W';
    restreq_t = 1;
  } else if (strncmp(ctype, "ZOPT", 4) == 0) {
    strcpy(sname_t, "Redshift");
    strcpy(units_t, "");
    ptype_t = 'W';
    restreq_t = 1;
  } else if (strncmp(ctype, "AWAV", 4) == 0) {
    strcpy(sname_t, "Air wavelength");
    strcpy(units_t, "m");
    ptype_t = 'A';
  } else if (strncmp(ctype, "VELO", 4) == 0) {
    strcpy(sname_t, "Relativistic velocity");
    strcpy(units_t, "m/s");
    ptype_t = 'V';
  } else if (strncmp(ctype, "BETA", 4) == 0) {
    strcpy(sname_t, "Velocity ratio (v/c)");
    strcpy(units_t, "");
    ptype_t = 'V';
  } else {
    return 2;
  }


  /* Determine X-type and validate the spectral algorithm code. */
  if ((xtype_t = ctype[5]) == ' ') {
    /* The algorithm code must be completely blank. */
    if (strcmp(ctype+4, "    ") != 0) {
a721 1
    }
d723 8
a730 1
    xtype_t = ptype_t;
d732 10
a741 2
  } else if (ctype[4] != '-') {
    return 2;
d743 3
a745 2
  } else if (strcmp(ctype+5, "LOG") == 0 || strcmp(ctype+5, "TAB") == 0) {
    /* Logarithmic or tabular axis, not linear in any spectral type. */
d747 2
a748 3
  } else if (xtype_t == 'G') {
    /* Validate the algorithm code. */
    if (ctype[6] != 'R') {
a749 1
    }
d751 17
a767 8
    /* Grism coordinates... */
    if (ctype[7] == 'I') {
      /* ...in vacuum. */
      xtype_t = 'w';
    } else if (ctype[7] == 'A') {
      /* ...in air. */
      xtype_t = 'a';
    } else {
d769 1
a769 1
    }
a770 40
  } else if (ctype[6] != '2') {
    /* Algorithm code has invalid syntax. */
    return 2;

  } else if (ctype[7] != ptype_t && ctype[7] != '?') {
    /* The P-, and S-type variables are inconsistent. */
    return 2;

  } else if (ctype[7] == ctype[5]) {
    /* Degenerate algorithm code. */
    sprintf(ctype+4, "    ");
  }


  /* Rest freq/wavelength required for transformation between P and X? */
  if (strchr("FWAwa", (int)xtype_t)) {
    if (ptype_t == 'V') {
      restreq_t += 2;
    }
  } else if (xtype_t == 'V') {
    if (strchr("FWAwa", (int)ptype_t)) {
      restreq_t += 2;
    }
  } else if (strchr("LT", (int)xtype_t) == 0) {
    /* Invalid X-type variable code. */
    return 2;
  }


  /* Copy results. */
  if (stype) {
    strncpy(stype, ctype, 4);
    stype[4] = '\0';
  }
  if (scode) strcpy(scode, ctype+5);
  if (sname) strcpy(sname, sname_t);
  if (units) strcpy(units, units_t);
  if (ptype) *ptype = ptype_t;
  if (xtype) *xtype = xtype_t;
  if (restreq) *restreq = restreq_t;
d772 11
d784 2
a785 1
  return 0;
d791 9
a799 9
  const char ctypeS[9],
  double crvalS,
  double restfrq,
  double restwav,
  char *ptype,
  char *xtype,
  int *restreq,
  double *crvalX,
  double *dXdS)
d802 42
a843 120
  char scode[4], stype[5], type[8];
  int  status;
  double dPdS, dXdP;
  struct spxprm spx;

  /* Analyse the spectral axis code. */
  if (spctyp(ctypeS, stype, scode, 0x0, 0x0, ptype, xtype, restreq)) {
    return 2;
  }

  if (strstr("LT", xtype)) {
    /* Can't handle logarithmic or tabular coordinates. */
    return 2;
  }

  /* Do we have rest frequency and/or wavelength as required? */
  if ((*restreq)%3 && restfrq == 0.0 && restwav == 0.0) {
    return 2;
  }

  /* Compute all spectral parameters and their derivatives. */
  strcpy(type, stype);
  if ((status = specx(type, crvalS, restfrq, restwav, &spx))) {
    return 2;
  }


  /* Transform S-P (linear) and P-X (non-linear). */
  dPdS = 0.0;
  dXdP = 0.0;
  if (*ptype == 'F') {
    if (strcmp(stype, "FREQ") == 0) {
      dPdS = 1.0;
    } else if (strcmp(stype, "AFRQ") == 0) {
      dPdS = spx.dfreqafrq;
    } else if (strcmp(stype, "ENER") == 0) {
      dPdS = spx.dfreqener;
    } else if (strcmp(stype, "WAVN") == 0) {
      dPdS = spx.dfreqwavn;
    } else if (strcmp(stype, "VRAD") == 0) {
      dPdS = spx.dfreqvrad;
    }

    if (*xtype == 'F') {
      *crvalX = spx.freq;
      dXdP = 1.0;
    } else if (*xtype == 'W' || *xtype == 'w') {
      *crvalX = spx.wave;
      dXdP = spx.dwavefreq;
    } else if (*xtype == 'A' || *xtype == 'a') {
      *crvalX = spx.awav;
      dXdP = spx.dawavfreq;
    } else if (*xtype == 'V') {
      *crvalX = spx.velo;
      dXdP = spx.dvelofreq;
    }

  } else if (*ptype == 'W' || *ptype == 'w') {
    if (strcmp(stype, "WAVE") == 0) {
      dPdS = 1.0;
    } else if (strcmp(stype, "VOPT") == 0) {
      dPdS = spx.dwavevopt;
    } else if (strcmp(stype, "ZOPT") == 0) {
      dPdS = spx.dwavezopt;
    }

    if (*xtype == 'F') {
      *crvalX = spx.freq;
      dXdP = spx.dfreqwave;
    } else if (*xtype == 'W' || *xtype == 'w') {
      *crvalX = spx.wave;
      dXdP = 1.0;
    } else if (*xtype == 'A' || *xtype == 'a') {
      *crvalX = spx.awav;
      dXdP = spx.dawavwave;
    } else if (*xtype == 'V') {
      *crvalX = spx.velo;
      dXdP = spx.dvelowave;
    }

  } else if (*ptype == 'A' || *ptype == 'a') {
    if (strcmp(stype, "AWAV") == 0) {
      dPdS = 1.0;
    }

    if (*xtype == 'F') {
      *crvalX = spx.freq;
      dXdP = spx.dfreqawav;
    } else if (*xtype == 'W' || *xtype == 'w') {
      *crvalX = spx.wave;
      dXdP = spx.dwaveawav;
    } else if (*xtype == 'A' || *xtype == 'a') {
      *crvalX = spx.awav;
      dXdP = 1.0;
    } else if (*xtype == 'V') {
      *crvalX = spx.velo;
      dXdP = spx.dveloawav;
    }

  } else if (*ptype == 'V') {
    if (strcmp(stype, "VELO") == 0) {
      dPdS = 1.0;
    } else if (strcmp(stype, "BETA") == 0) {
      dPdS = spx.dvelobeta;
    }

    if (*xtype == 'F') {
      *crvalX = spx.freq;
      dXdP = spx.dfreqvelo;
    } else if (*xtype == 'W' || *xtype == 'w') {
      *crvalX = spx.wave;
      dXdP = spx.dwavevelo;
    } else if (*xtype == 'A' || *xtype == 'a') {
      *crvalX = spx.awav;
      dXdP = spx.dawavvelo;
    } else if (*xtype == 'V') {
      *crvalX = spx.velo;
      dXdP = 1.0;
    }
  }
d845 79
a923 1
  *dXdS = dXdP * dPdS;
d925 1
a925 1
  return 0;
d931 9
a939 9
  const char ctypeS[9],
  double crvalX,
  double restfrq,
  double restwav,
  char *ptype,
  char *xtype,
  int *restreq,
  double *crvalS,
  double *dSdX)
d942 9
a950 124
  char scode[4], stype[5], type[8];
  int  status;
  double dPdX, dSdP;
  struct spxprm spx;

  /* Analyse the spectral axis type. */
  if (spctyp(ctypeS, stype, scode, 0x0, 0x0, ptype, xtype, restreq)) {
    return 2;
  }

  if (strstr("LT", xtype)) {
    /* Can't handle logarithmic or tabular coordinates. */
    return 2;
  }

  /* Do we have rest frequency and/or wavelength as required? */
  if ((*restreq)%3 && restfrq == 0.0 && restwav == 0.0) {
    return 2;
  }

  /* Compute all spectral parameters and their derivatives. */
  if (*xtype == 'F') {
    strcpy(type, "FREQ");
  } else if (*xtype == 'W' || *xtype == 'w') {
    strcpy(type, "WAVE");
  } else if (*xtype == 'A' || *xtype == 'a') {
    strcpy(type, "AWAV");
  } else if (*xtype == 'V') {
    strcpy(type, "VELO");
  }

  if ((status = specx(type, crvalX, restfrq, restwav, &spx))) {
    return 2;
  }


  /* Transform X-P (non-linear) and P-S (linear). */
  dPdX = 0.0;
  dSdP = 0.0;
  if (*ptype == 'F') {
    if (*xtype == 'F') {
      dPdX = 1.0;
    } else if (*xtype == 'W' || *xtype == 'w') {
      dPdX = spx.dfreqwave;
    } else if (*xtype == 'A' || *xtype == 'a') {
      dPdX = spx.dfreqawav;
    } else if (*xtype == 'V') {
      dPdX = spx.dfreqvelo;
    }

    if (strcmp(stype, "FREQ") == 0) {
      *crvalS = spx.freq;
      dSdP = 1.0;
    } else if (strcmp(stype, "AFRQ") == 0) {
      *crvalS = spx.afrq;
      dSdP = spx.dafrqfreq;
    } else if (strcmp(stype, "ENER") == 0) {
      *crvalS = spx.ener;
      dSdP = spx.denerfreq;
    } else if (strcmp(stype, "WAVN") == 0) {
      *crvalS = spx.wavn;
      dSdP = spx.dwavnfreq;
    } else if (strcmp(stype, "VRAD") == 0) {
      *crvalS = spx.vrad;
      dSdP = spx.dvradfreq;
    }

  } else if (*ptype == 'W') {
    if (*xtype == 'F') {
      dPdX = spx.dwavefreq;
    } else if (*xtype == 'W' || *xtype == 'w') {
      dPdX = 1.0;
    } else if (*xtype == 'A' || *xtype == 'a') {
      dPdX = spx.dwaveawav;
    } else if (*xtype == 'V') {
      dPdX = spx.dwavevelo;
    }

    if (strcmp(stype, "WAVE") == 0) {
      *crvalS = spx.wave;
      dSdP = 1.0;
    } else if (strcmp(stype, "VOPT") == 0) {
      *crvalS = spx.vopt;
      dSdP = spx.dvoptwave;
    } else if (strcmp(stype, "ZOPT") == 0) {
      *crvalS = spx.zopt;
      dSdP = spx.dzoptwave;
    }

  } else if (*ptype == 'A') {
    if (*xtype == 'F') {
      dPdX = spx.dawavfreq;
    } else if (*xtype == 'W' || *xtype == 'w') {
      dPdX = spx.dawavwave;
    } else if (*xtype == 'A' || *xtype == 'a') {
      dPdX = 1.0;
    } else if (*xtype == 'V') {
      dPdX = spx.dawavvelo;
    }

    if (strcmp(stype, "AWAV") == 0) {
      *crvalS = spx.awav;
      dSdP = 1.0;
    }

  } else if (*ptype == 'V') {
    if (*xtype == 'F') {
      dPdX = spx.dvelofreq;
    } else if (*xtype == 'W' || *xtype == 'w') {
      dPdX = spx.dvelowave;
    } else if (*xtype == 'A' || *xtype == 'a') {
      dPdX = spx.dveloawav;
    } else if (*xtype == 'V') {
      dPdX = 1.0;
    }

    if (strcmp(stype, "VELO") == 0) {
      *crvalS = spx.velo;
      dSdP = 1.0;
    } else if (strcmp(stype, "BETA") == 0) {
      *crvalS = spx.beta;
      dSdP = spx.dbetavelo;
    }
  }
d952 116
a1067 1
  *dSdX = dSdP * dPdX;
d1069 1
a1069 1
  return 0;
d1075 8
a1082 8
  const char ctypeS1[9],
  double crvalS1,
  double cdeltS1,
  double restfrq,
  double restwav,
  char   ctypeS2[9],
  double *crvalS2,
  double *cdeltS2)
d1085 43
a1127 43
  char *cp, ptype1, ptype2, xtype1, xtype2;
  int  restreq, status;
  double crvalX, dS2dX, dXdS1;

  if ((status = spcspx(ctypeS1, crvalS1, restfrq, restwav, &ptype1, &xtype1,
                       &restreq, &crvalX, &dXdS1))) {
    return status;
  }

  /* Blank fill. */
  ctypeS2[8] = '\0';
  for (cp = ctypeS2; *cp; cp++);
  while (cp < ctypeS2+8) *(cp++) = ' ';

  if (strncmp(ctypeS2+5, "???", 3) == 0) {
    /* Set the algorithm code if required. */
    if (xtype1 == 'w') {
      strcpy(ctypeS2+5, "GRI");
    } else if (xtype1 == 'a') {
      strcpy(ctypeS2+5, "GRA");
    } else {
      ctypeS2[5] = xtype1;
      ctypeS2[6] = '2';
    }
  }

  if ((status = spcxps(ctypeS2, crvalX, restfrq, restwav, &ptype2, &xtype2,
                       &restreq, crvalS2, &dS2dX))) {
    return status;
  }

  /* Are the X-types compatible? */
  if (xtype2 != xtype1) {
    return 2;
  }

  if (ctypeS2[7] == '?') {
    if (ptype2 == xtype2) {
      strcpy(ctypeS2+4, "    ");
    } else {
      ctypeS2[7] = ptype2;
    }
  }
d1129 1
a1129 1
  *cdeltS2 = dS2dX * dXdS1 * cdeltS1;
d1131 1
a1131 1
  return 0;
@


4.2
log
@WCSLIB 4.2
@
text
@d2 30
a31 29
*
*   WCSLIB 4.2 - an implementation of the FITS WCS standard.
*   Copyright (C) 1995-2005, Mark Calabretta
*
*   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.
*
*   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.
*
*   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
*
*   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
*
*   Author: Mark Calabretta, Australia Telescope National Facility
*   http://www.atnf.csiro.au/~mcalabre/index.html
*   $Id: spc.c,v 4.1 2005/08/25 08:09:02 cal103 Exp cal103 $
d170 4
a173 4
   printf("     spxX2P: 0x%x\n", (int)spc->spxX2P);
   printf("     spxP2S: 0x%x\n", (int)spc->spxP2S);
   printf("     spxS2P: 0x%x\n", (int)spc->spxS2P);
   printf("     spxP2X: 0x%x\n", (int)spc->spxP2X);
d203 2
a204 2
   if (status = spcspx(ctype, spc->crval, restfrq, restwav, &ptype, &xtype,
                       &restreq, &crvalX, &dXdS)) {
d504 2
a505 2
      if (statX2P = spc->spxX2P(spc->w[0], nx, sspec, sspec, spec, spec,
                                stat)) {
d517 2
a518 2
      if (statP2S = spc->spxP2S(spc->w[0], nx, sspec, sspec, spec, spec,
                                stat)) {
d559 2
a560 1
      if (statS2P = spc->spxS2P(spc->w[0], nspec, sspec, sx, spec, x, stat)) {
d583 1
a583 1
      if (statP2X = spc->spxP2X(spc->w[0], nspec, sx, sx, x, x, stat)) {
d808 1
a808 1
   if (spctyp(ctypeS, stype, scode, 0, 0, ptype, xtype, restreq)) {
d824 1
a824 1
   if (status = specx(type, crvalS, restfrq, restwav, &spx)) {
d948 1
a948 1
   if (spctyp(ctypeS, stype, scode, 0, 0, ptype, xtype, restreq)) {
d973 1
a973 1
   if (status = specx(type, crvalX, restfrq, restwav, &spx)) {
d1089 2
a1090 2
   if (status = spcspx(ctypeS1, crvalS1, restfrq, restwav, &ptype1, &xtype1,
                       &restreq, &crvalX, &dXdS1)) {
d1111 2
a1112 2
   if (status = spcxps(ctypeS2, crvalX, restfrq, restwav, &ptype2, &xtype2,
                       &restreq, crvalS2, &dS2dX)) {
@


4.2.1.1
log
@WCSLIB 4.2 development branch.
@
text
@d3 1
a3 1
*   WCSLIB 4.3 - an implementation of the FITS WCS standard.
d30 1
a30 1
*   $Id: spc.c,v 4.2 2005/09/21 13:21:57 cal103 Exp cal103 $
@


4.2.1.2
log
@In spcprt(), use the "%p" printf conversion specifier to print addresses
rather than casting the pointer to int and using "#x".  The latter does not
work on 64-bit machines where sizeof(int) != sizeof(void*).
@
text
@d4 1
a4 1
*   Copyright (C) 1995-2006, Mark Calabretta
d30 1
a30 1
*   $Id: spc.c,v 4.2.1.1 2005/12/05 02:39:43 cal103 Exp cal103 $
d169 4
a172 4
   printf("     spxX2P: %p\n", spc->spxX2P);
   printf("     spxP2S: %p\n", spc->spxP2S);
   printf("     spxS2P: %p\n", spc->spxS2P);
   printf("     spxP2X: %p\n", spc->spxP2X);
@


4.2.1.3
log
@Parenthesised assignments used as truth values.
@
text
@d4 1
a4 1
*   Copyright (C) 1995-2007, Mark Calabretta
d30 1
a30 1
*   $Id: spc.c,v 4.2.1.2 2006/06/01 07:34:15 cal103 Exp cal103 $
d202 2
a203 2
   if ((status = spcspx(ctype, spc->crval, restfrq, restwav, &ptype, &xtype,
                        &restreq, &crvalX, &dXdS))) {
d503 2
a504 2
      if ((statX2P = spc->spxX2P(spc->w[0], nx, sspec, sspec, spec, spec,
                                 stat))) {
d516 2
a517 2
      if ((statP2S = spc->spxP2S(spc->w[0], nx, sspec, sspec, spec, spec,
                                 stat))) {
d558 1
a558 2
      if ((statS2P = spc->spxS2P(spc->w[0], nspec, sspec, sx, spec, x,
                                 stat))) {
d581 1
a581 1
      if ((statP2X = spc->spxP2X(spc->w[0], nspec, sx, sx, x, x, stat))) {
d822 1
a822 1
   if ((status = specx(type, crvalS, restfrq, restwav, &spx))) {
d971 1
a971 1
   if ((status = specx(type, crvalX, restfrq, restwav, &spx))) {
d1087 2
a1088 2
   if ((status = spcspx(ctypeS1, crvalS1, restfrq, restwav, &ptype1, &xtype1,
                        &restreq, &crvalX, &dXdS1))) {
d1109 2
a1110 2
   if ((status = spcxps(ctypeS2, crvalX, restfrq, restwav, &ptype2, &xtype2,
                        &restreq, crvalS2, &dS2dX))) {
@


4.2.1.4
log
@Cast pointers to (void *) for %p formatting by printf() to avert a compiler
warning.
@
text
@d30 1
a30 1
*   $Id: spc.c,v 4.2.1.3 2007/06/29 00:42:53 cal103 Exp cal103 $
d169 4
a172 4
   printf("     spxX2P: %p\n", (void *)spc->spxX2P);
   printf("     spxP2S: %p\n", (void *)spc->spxP2S);
   printf("     spxS2P: %p\n", (void *)spc->spxS2P);
   printf("     spxP2X: %p\n", (void *)spc->spxP2X);
@


4.2.1.5
log
@Cosmetic change, use 0x0 for null pointers in calls to spctyp().
@
text
@d30 1
a30 1
*   $Id: spc.c,v 4.2.1.4 2007/07/11 02:01:30 cal103 Exp cal103 $
d807 1
a807 1
   if (spctyp(ctypeS, stype, scode, 0x0, 0x0, ptype, xtype, restreq)) {
d947 1
a947 1
   if (spctyp(ctypeS, stype, scode, 0x0, 0x0, ptype, xtype, restreq)) {
@


4.2.1.6
log
@Switched to LGPL 3.0.
@
text
@d2 29
a30 30

    WCSLIB 4.3 - an implementation of the FITS WCS standard.
    Copyright (C) 1995-2007, 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/>.

    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

    Author: Mark Calabretta, Australia Telescope National Facility
    http://www.atnf.csiro.au/~mcalabre/index.html
    $Id: spc.c,v 4.2.1.5 2007/07/27 08:43:10 cal103 Exp cal103 $
@


4.1
log
@WCSLIB 4.1: set spc_errmsg[0] to "success"; removed logarithmic conversions;
initialize spcprm.spxX2P, spxP2S, spxS2P, and spxP2X in spcini(); changed the
argument list to spctyp() to translate AIPS spectral axis types and return
the translated value; also generalized spctyp() so that all return arguments
may be set to null pointers if they are not wanted; fixed a bug in spctrn().
@
text
@d3 1
a3 1
*   WCSLIB 4.1 - an implementation of the FITS WCS standard.
d30 1
a30 1
*   $Id: spc.c,v 4.0 2005/02/04 05:27:55 cal103 Exp cal103 $
@


4.0
log
@WCSLIB 4.0: changed from LGPL to GPL; new functions: spchek() checks a
spectral algorithm code for legitimacy; from the spectral keywords given,
spcspx() derives the corresponding CRVALi and CDELTi keywords for the
underlying P-, and X-type spectral coordinates; spcxps() does the opposite;
spctrn() combines spcspx() and spcxps() to translate one set of spectral
keywords into another, e.g.  'FREQ' -> 'ZOPT-F2W'; macros for UNDEFINED values
moved to wcsmath.h; extensive changes to the code, including renaming variables
to match Paper III.
@
text
@d3 1
a3 1
*   WCSLIB 4.0 - an implementation of the FITS WCS standard.
d30 1
a30 1
*   $Id: spc.c,v 3.6 2004/08/25 04:07:22 cal103 Exp cal103 $
d43 6
a48 17
const int  spc_ncode = 17;
const char spc_codes[15][4] =
      {"LOG",			/* Logarithmic axis.                  */
       "F2W", "F2A", "F2V",	/* Axis linear in frequency.          */
       "W2F", "W2A", "W2V",	/* Axis linear in vacuum wavelengths. */
       "A2F", "A2W", "A2V",	/* Axis linear in air wavelength.     */
       "V2F", "V2W", "V2A",	/* Axis linear in velocity.           */
       "GRI", "GRA"};		/* Grism in vacuum or air.            */

/* Spectral algorithm codes. */
#define LOG 100;		/* Logarithmic axis.                  */
#define F2S 200;		/* Axis linear in frequency.          */
#define W2S 300;		/* Axis linear in vacuum wavelengths. */
#define A2S 400;		/* Axis linear in air wavelengths.    */
#define V2S 500;		/* Axis linear in velocity.           */
#define GRI 600;		/* Grism in vacuum.                   */
#define GRA 700;		/* Grism in air.                      */
d66 1
a66 1
   0,
d82 1
a82 1
   if (spc == 0) return 1;
d90 2
a91 2
   spc->restfrq = 0.0;
   spc->restwav = 0.0;
a96 2
   spc->isGrism = 0;

d101 7
d118 1
a118 1
   if (spc == 0) return 1;
d187 1
a187 1
   if (spc == 0) return 1;
a197 21
   /* Logarithmic axes. */
   if (strcmp(spc->code, "LOG") == 0) {
      if (spc->crval == 0.0) {
         return 2;
      }

      spc->flag = LOG;

      spc->w[1] = log(spc->crval);
      spc->w[2] = 1.0/spc->crval;

      spc->spxP2S = 0;
      spc->spxS2P = 0;

      spc->spxX2P = logspec;
      spc->spxP2X = speclog;

      return 0;
   }


d244 2
a245 2
         spc->spxP2S = 0;
         spc->spxS2P = 0;
d276 2
a277 2
         spc->spxP2S = 0;
         spc->spxS2P = 0;
d296 2
a297 2
         spc->spxP2S = 0;
         spc->spxS2P = 0;
d304 2
a305 2
         spc->spxP2S = 0;
         spc->spxS2P = 0;
d322 2
a323 2
         spc->spxX2P = 0;
         spc->spxP2X = 0;
d347 2
a348 2
         spc->spxX2P = 0;
         spc->spxP2X = 0;
d378 2
a379 2
         spc->spxX2P = 0;
         spc->spxP2X = 0;
d409 2
a410 2
         spc->spxX2P = 0;
         spc->spxP2X = 0;
d415 1
a415 1
   
d477 1
a477 1
   if (spc == 0) return 1;
d502 1
a502 1
   if (spc->spxX2P != 0) {
d515 1
a515 1
   if (spc->spxP2S != 0) {
d550 1
a550 1
   if (spc == 0) return 1;
d557 1
a557 1
   if (spc->spxS2P != 0) {
d580 1
a580 1
   if (spc->spxP2X != 0) {
d624 4
a627 2
   const char ctype[9],
   char cname[],
d634 21
a654 1
   *restreq = 0;
d658 3
a660 3
      if (cname) strcpy(cname, "Frequency");
      if (units) strcpy(units, "(Hz)");
      *ptype = 'F';
d662 3
a664 3
      if (cname) strcpy(cname, "Angular frequency");
      if (units) strcpy(units, "(deg/s)");
      *ptype = 'F';
d666 3
a668 3
      if (cname) strcpy(cname, "Photon energy");
      if (units) strcpy(units, "(J)");
      *ptype = 'F';
d670 3
a672 3
      if (cname) strcpy(cname, "Wavenumber");
      if (units) strcpy(units, "(1/m)");
      *ptype = 'F';
d674 4
a677 4
      if (cname) strcpy(cname, "Radio velocity");
      if (units) strcpy(units, "(m/s)");
      *ptype = 'F';
      *restreq = 1;
d679 3
a681 3
      if (cname) strcpy(cname, "Vacuum wavelength");
      if (units) strcpy(units, "(m)");
      *ptype = 'W';
d683 4
a686 4
      if (cname) strcpy(cname, "Optical velocity");
      if (units) strcpy(units, "(m/s)");
      *ptype = 'W';
      *restreq = 1;
d688 4
a691 4
      if (cname) strcpy(cname, "Redshift");
      if (units) strcpy(units, "");
      *ptype = 'W';
      *restreq = 1;
d693 3
a695 3
      if (cname) strcpy(cname, "Air wavelength");
      if (units) strcpy(units, "(m)");
      *ptype = 'A';
d697 3
a699 3
      if (cname) strcpy(cname, "Relativistic velocity");
      if (units) strcpy(units, "(m/s)");
      *ptype = 'V';
d701 3
a703 3
      if (cname) strcpy(cname, "Velocity ratio (v/c)");
      if (units) strcpy(units, "");
      *ptype = 'V';
d710 1
a710 1
   if ((*xtype = ctype[5]) == ' ') {
d712 1
a712 1
      if (strncmp(ctype+4, "    ", 4) != 0) {
d716 1
a716 1
      *xtype = *ptype;
d721 4
a724 1
   } else if (*xtype == 'G') {
d733 1
a733 1
         *xtype = 'w';
d736 1
a736 1
         *xtype = 'a';
d745 1
a745 1
   } else if (ctype[7] != *ptype && ctype[7] != '?') {
d751 1
a751 1
      return 2;
d756 7
a762 7
   if (strchr("FWAwa", *xtype)) {
      if (*ptype == 'V') {
         *restreq += 2;
      }
   } else if (*xtype == 'V') {
      if (strchr("FWAwa", *ptype)) {
         *restreq += 2;
d764 1
a764 1
   } else {
d769 14
d800 1
a800 1
   char type[8];
d806 6
a811 1
   if (spctyp(ctypeS, 0, 0, ptype, xtype, restreq)) {
d821 1
a821 2
   strncpy(type, ctypeS, 4);
   type[4] = '\0';
d831 1
a831 1
      if (strncmp(ctypeS, "FREQ", 4) == 0) {
d833 1
a833 1
      } else if (strncmp(ctypeS, "AFRQ", 4) == 0) {
d835 1
a835 1
      } else if (strncmp(ctypeS, "ENER", 4) == 0) {
d837 1
a837 1
      } else if (strncmp(ctypeS, "WAVN", 4) == 0) {
d839 1
a839 1
      } else if (strncmp(ctypeS, "VRAD", 4) == 0) {
d858 1
a858 1
      if (strncmp(ctypeS, "WAVE", 4) == 0) {
d860 1
a860 1
      } else if (strncmp(ctypeS, "VOPT", 4) == 0) {
d862 1
a862 1
      } else if (strncmp(ctypeS, "ZOPT", 4) == 0) {
d881 1
a881 1
      if (strncmp(ctypeS, "AWAV", 4) == 0) {
d900 1
a900 1
      if (strncmp(ctypeS, "VELO", 4) == 0) {
d902 1
a902 1
      } else if (strncmp(ctypeS, "BETA", 4) == 0) {
d940 1
a940 1
   char type[8];
d946 6
a951 1
   if (spctyp(ctypeS, 0, 0, ptype, xtype, restreq)) {
d990 1
a990 1
      if (strncmp(ctypeS, "FREQ", 4) == 0) {
d993 1
a993 1
      } else if (strncmp(ctypeS, "AFRQ", 4) == 0) {
d996 1
a996 1
      } else if (strncmp(ctypeS, "ENER", 4) == 0) {
d999 1
a999 1
      } else if (strncmp(ctypeS, "WAVN", 4) == 0) {
d1002 1
a1002 1
      } else if (strncmp(ctypeS, "VRAD", 4) == 0) {
d1018 1
a1018 1
      if (strncmp(ctypeS, "WAVE", 4) == 0) {
d1021 1
a1021 1
      } else if (strncmp(ctypeS, "VOPT", 4) == 0) {
d1024 1
a1024 1
      } else if (strncmp(ctypeS, "ZOPT", 4) == 0) {
d1040 1
a1040 1
      if (strncmp(ctypeS, "AWAV", 4) == 0) {
d1056 1
a1056 1
      if (strncmp(ctypeS, "VELO", 4) == 0) {
d1059 1
a1059 1
      } else if (strncmp(ctypeS, "BETA", 4) == 0) {
d1083 1
a1083 1
   char ptype1, ptype2, xtype1, xtype2;
d1092 6
a1097 1
   if (strncmp(ctypeS2+5, "???", 3)) {
d1109 1
a1109 1
   if (status = spcxps(ctypeS2, crvalX, restfrq, restwav, &xtype2, &ptype2,
d1119 1
a1119 1
   if (ctypeS2[7] = '?') {
d1121 1
a1121 1
        strcpy(ctypeS2+5, "    ");
@


3.6
log
@WCSLIB 3.6: "error status/code/number" is now referred to consistently as the
"status return value".
@
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 library is free software; you can redistribute it and/or modify it
*   under the terms of the GNU Library 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 library 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 Library
*   General Public License for more details.
d16 3
a18 3
*   You should have received a copy of the GNU Library 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: spc.c,v 3.5 2004/06/28 01:49:39 mcalabre Exp mcalabre $
d37 1
d52 1
a52 1
/* Spectral algorithm types. */
d61 1
a61 1
/* Spectral coordinate types. */
a83 3
#define UNDEFINED 987654321.0e99
#define undefined(value) (value == UNDEFINED)

d88 1
a88 3
int spcini(spc)

struct spcprm *spc;
d119 1
a119 3
int spcprt(spc)

const struct spcprm *spc;
d175 4
a178 4
   printf("     spxx2q: 0x%x\n", (int)spc->spxx2q);
   printf("     spxq2s: 0x%x\n", (int)spc->spxq2s);
   printf("     spxs2q: 0x%x\n", (int)spc->spxs2q);
   printf("     spxq2x: 0x%x\n", (int)spc->spxq2x);
d185 1
a185 3
int spcset(spc)

struct spcprm *spc;
d188 4
a191 4
   char   p, x;
   int    status;
   double alpha, beta_r, dn_r, epsilon, G, m, lambda_r, n_r, t, theta;
   struct spxprm spx;
d206 4
d215 2
a216 2
      spc->spxq2s = 0;
      spc->spxs2q = 0;
d218 2
a219 2
      spc->spxx2q = logspec;
      spc->spxq2x = speclog;
d224 7
a230 3
   /* Compute all spectral parameters and their derivatives. */
   if (status = specx(spc->type, spc->crval, spc->restfrq, spc->restwav,
                      &spx)) {
d234 7
a240 24

   /* Set pointers-to-functions for the linear part of the transformation. */
   if (strcmp(spc->code, "GRI") == 0) {
      spc->isGrism = 1;
   } else if (strcmp(spc->code, "GRA") == 0) {
      spc->isGrism = 2;
   } else {
      spc->isGrism = 0;
   }

   if (spc->isGrism) {
      p = '*';
   } else {
      p = spc->code[2];
   }

   if (strcmp(spc->type, "FREQ") == 0) {
      /* Frequency. */
      if (!spx.wavetype) return 2;

      if (p == '*') {
         p = 'F';
      } else if (p != 'F') {
         return 2;
d243 4
a246 13
      spc->flag = FREQ;
      spc->w[2] = 1.0;
      spc->spxq2s = 0;
      spc->spxs2q = 0;

   } else if (strcmp(spc->type, "AFRQ") == 0) {
      /* Angular frequency. */
      if (!spx.wavetype) return 2;

      if (p == '*') {
         p = 'F';
      } else if (p != 'F') {
         return 2;
d249 10
a258 13
      spc->flag = AFRQ;
      spc->w[2] = spx.dfreqafrq;
      spc->spxq2s = freqafrq;
      spc->spxs2q = afrqfreq;

   } else if (strcmp(spc->type, "ENER") == 0) {
      /* Photon energy. */
      if (!spx.wavetype) return 2;

      if (p == '*') {
         p = 'F';
      } else if (p != 'F') {
         return 2;
d260 1
d262 2
a263 14
      spc->flag = ENER;
      spc->w[2] = spx.dfreqener;
      spc->spxq2s = freqener;
      spc->spxs2q = enerfreq;

   } else if (strcmp(spc->type, "WAVN") == 0) {
      /* Wave number. */
      if (!spx.wavetype) return 2;

      if (p == '*') {
         p = 'F';
      } else if (p != 'F') {
         return 2;
      }
a264 14
      spc->flag = WAVN;
      spc->w[2] = spx.dfreqwavn;
      spc->spxq2s = freqwavn;
      spc->spxs2q = wavnfreq;

   } else if (strcmp(spc->type, "VRAD") == 0) {
      /* Radio velocity. */
      if (!spx.velotype) return 2;

      if (p == '*') {
         p = 'F';
      } else if (p != 'F') {
         return 2;
      }
d266 73
a338 14
      spc->flag = VRAD;
      spc->w[0] = spc->restfrq;
      spc->w[2] = spx.dfreqvrad;
      spc->spxq2s = freqvrad;
      spc->spxs2q = vradfreq;

   } else if (strcmp(spc->type, "WAVE") == 0) {
      /* Vacuum wavelengths. */
      if (!spx.wavetype) return 2;

      if (p == '*') {
         p = 'W';
      } else if (p != 'W') {
         return 2;
a339 87

      spc->flag = WAVE;
      spc->w[2] = 1.0;
      spc->spxq2s = 0;
      spc->spxs2q = 0;

   } else if (strcmp(spc->type, "VOPT") == 0) {
      /* Optical velocity. */
      if (!spx.velotype) return 2;

      if (p == '*') {
         p = 'W';
      } else if (p != 'W') {
         return 2;
      }

      spc->flag = VOPT;
      spc->w[0] = spc->restwav;
      spc->w[2] = spx.dwavevopt;
      spc->spxq2s = wavevopt;
      spc->spxs2q = voptwave;

   } else if (strcmp(spc->type, "ZOPT") == 0) {
      /* Redshift. */
      if (!spx.velotype) return 2;

      if (p == '*') {
         p = 'W';
      } else if (p != 'W') {
         return 2;
      }

      spc->flag = ZOPT;
      spc->w[0] = spc->restwav;
      spc->w[2] = spx.dwavezopt;
      spc->spxq2s = wavezopt;
      spc->spxs2q = zoptwave;

   } else if (strcmp(spc->type, "AWAV") == 0) {
      /* Air wavelengths. */
      if (!spx.wavetype) return 2;

      if (p == '*') {
         p = 'A';
      } else if (p != 'A') {
         return 2;
      }

      spc->flag = AWAV;
      spc->w[2] = 1.0;
      spc->spxq2s = 0;
      spc->spxs2q = 0;

   } else if (strcmp(spc->type, "VELO") == 0) {
      /* Relativistic velocity. */
      if (!spx.velotype) return 2;

      if (p == '*') {
         p = 'V';
      } else if (p != 'V') {
         return 2;
      }

      spc->flag = VELO;
      spc->w[2] = 1.0;
      spc->spxq2s = 0;
      spc->spxs2q = 0;

   } else if (strcmp(spc->type, "BETA") == 0) {
      /* Velocity ratio (v/c). */
      if (!spx.velotype) return 2;

      if (p == '*') {
         p = 'V';
      } else if (p != 'V') {
         return 2;
      }

      spc->flag = BETA;
      spc->w[2] = spx.dvelobeta;
      spc->spxq2s = velobeta;
      spc->spxs2q = betavelo;

   } else {
      /* Unrecognized coordinate type. */
      return 2;

d345 2
a346 2
   x = spc->code[0];
   if (x == 'F') {
d348 16
a363 1
      if (!spx.wavetype) return 2;
d365 1
a365 15
      if (strcmp(spc->code, "F2W") == 0) {
         spc->w[2] *= spx.dfreqwave;
         spc->spxx2q = freqwave;
         spc->spxq2x = wavefreq;

      } else if (strcmp(spc->code, "F2A") == 0) {
         spc->w[2] *= spx.dfreqawav;
         spc->spxx2q = freqawav;
         spc->spxq2x = awavfreq;

      } else if (strcmp(spc->code, "F2V") == 0) {
         spc->w[0] = spc->restfrq;
         spc->w[2] *= spx.dfreqvelo;
         spc->spxx2q = freqvelo;
         spc->spxq2x = velofreq;
d367 5
a371 4
      } else {
         /* Unrecognized spectral algorithm code. */
         return 2;
      }
d373 3
a375 2
      spc->flag += F2S;
      spc->w[1] = spx.freq;
d377 3
a379 2
   } else if (x == 'W') {
      if (!spx.wavetype) return 2;
d381 4
a384 16
      /* Axis is linear in vacuum wavelengths. */
      if (strcmp(spc->code, "W2F") == 0) {
         spc->w[2] *= spx.dwavefreq;
         spc->spxx2q = wavefreq;
         spc->spxq2x = freqwave;

      } else if (strcmp(spc->code, "W2A") == 0) {
         spc->w[2] *= spx.dwaveawav;
         spc->spxx2q = waveawav;
         spc->spxq2x = awavwave;

      } else if (strcmp(spc->code, "W2V") == 0) {
         spc->w[0] = spc->restwav;
         spc->w[2] *= spx.dwavevelo;
         spc->spxx2q = wavevelo;
         spc->spxq2x = velowave;
d386 2
d389 3
a391 2
         /* Unrecognized spectral algorithm code. */
         return 2;
d394 9
a402 2
      spc->flag += W2S;
      spc->w[1] = spx.wave;
d404 3
a406 2
   } else if (x == 'A') {
      if (!spx.wavetype) return 2;
d408 4
a411 16
      /* Axis is linear in air wavelengths. */
      if (strcmp(spc->code, "A2F") == 0) {
         spc->w[2] *= spx.dawavfreq;
         spc->spxx2q = awavfreq;
         spc->spxq2x = freqawav;

      } else if (strcmp(spc->code, "A2W") == 0) {
         spc->w[2] *= spx.dawavwave;
         spc->spxx2q = awavwave;
         spc->spxq2x = waveawav;

      } else if (strcmp(spc->code, "A2V") == 0) {
         spc->w[0] = spc->restwav;
         spc->w[2] *= spx.dawavvelo;
         spc->spxx2q = awavvelo;
         spc->spxq2x = veloawav;
d413 2
d416 3
a418 2
         /* Unrecognized spectral algorithm code. */
         return 2;
d421 1
a421 6
      spc->flag += A2S;
      spc->w[1] = spx.awav;

   } else if (x == 'V') {
      if (!spx.velotype) return 2;

d423 15
a437 21
      if (strcmp(spc->code, "V2F") == 0) {
         spc->w[0] = spc->restfrq;
         spc->w[2] *= spx.dvelofreq;
         spc->spxx2q = velofreq;
         spc->spxq2x = freqvelo;

      } else if (strcmp(spc->code, "V2W") == 0) {
         spc->w[0] = spc->restwav;
         spc->w[2] *= spx.dvelowave;
         spc->spxx2q = velowave;
         spc->spxq2x = wavevelo;

      } else if (strcmp(spc->code, "V2A") == 0) {
         spc->w[0] = spc->restwav;
         spc->w[2] *= spx.dveloawav;
         spc->spxx2q = veloawav;
         spc->spxq2x = awavvelo;

      } else {
         /* Unrecognized spectral algorithm code. */
         return 2;
d441 2
a442 1
      spc->w[1] = spx.velo;
d444 2
a445 1
   } else if (spc->isGrism) {
d447 1
a447 62
      if (!spx.wavetype) return 2;

      if (spc->isGrism == 1) {
         /* Grism in vacuum. */
         if (p == 'F') {
            spc->w[2] *= spx.dwavefreq;
            spc->spxx2q = wavefreq;
            spc->spxq2x = freqwave;

         } else if (p == 'W') {
            spc->spxx2q = 0;
            spc->spxq2x = 0;

         } else if (p == 'A') {
            spc->w[2] *= spx.dwaveawav;
            spc->spxx2q = waveawav;
            spc->spxq2x = awavwave;

         } else if (p == 'V') {
            spc->w[0] = spc->restwav;
            spc->w[2] *= spx.dwavevelo;
            spc->spxx2q = wavevelo;
            spc->spxq2x = velowave;

         } else {
            /* Shouldn't be possible. */
            return 2;
         }

         lambda_r = spx.wave;
         spc->flag += GRI;

      } else {
         /* Grism in air. */
         if (p == 'F') {
            spc->w[2] *= spx.dawavfreq;
            spc->spxx2q = awavfreq;
            spc->spxq2x = freqawav;

         } else if (p == 'W') {
            spc->w[2] *= spx.dawavwave;
            spc->spxx2q = awavwave;
            spc->spxq2x = waveawav;

         } else if (p == 'A') {
            spc->spxx2q = 0;
            spc->spxq2x = 0;

         } else if (p == 'V') {
            spc->w[0] = spc->restwav;
            spc->w[2] *= spx.dawavvelo;
            spc->spxx2q = awavvelo;
            spc->spxq2x = veloawav;

         } else {
            /* Shouldn't be possible. */
            return 2;
         }

         lambda_r = spx.awav;
         spc->flag += GRA;
      }
a476 4

   } else {
      /* Unrecognized spectral algorithm code. */
      return 2;
d485 8
a492 7
int spcx2s(spc, nx, sx, sspec, x, spec, stat)

struct spcprm *spc;
int nx, sspec, sx;
const double x[];
double spec[];
int stat[];
d495 1
a495 1
   int statq2s, status = 0, statx2q;
d527 4
a530 4
   /* Apply the non-linear step of the algorithm chain to convert spectral */
   /* coordinate X to intermediate spectral coordinate Q.                  */
   if (spc->spxx2q != 0) {
      if (statx2q = spc->spxx2q(spc->w[0], nx, sspec, sspec, spec, spec,
d532 1
a532 1
         if (statx2q == 4) {
d535 1
a535 1
            return statx2q;
d540 6
a545 6
   /* Apply the linear step of the algorithm chain to convert intermediate */
   /* spectral coordinate Q to the required spectral coordinate S.         */
   if (spc->spxq2s != 0) {
      if (statq2s = spc->spxq2s(spc->w[0], nx, sspec, sspec, spec, spec,
                                stat)) {;
         if (statq2s == 4) {
d548 1
a548 1
            return statq2s;
d558 8
a565 7
int spcs2x(spc, nspec, sspec, sx, spec, x, stat)

struct spcprm *spc;
int nspec, sspec, sx;
const double spec[];
double x[];
int stat[];
d568 1
a568 1
   int statq2x, status = 0, stats2q;
d582 5
a586 5
   /* Apply the linear step of the algorithm chain to convert spectral */
   /* coordinate S to intermediate spectral coordinate Q.              */
   if (spc->spxs2q != 0) {
      if (stats2q = spc->spxs2q(spc->w[0], nspec, sspec, sx, spec, x, stat)) {
         if (stats2q == 4) {
d589 1
a589 1
            return stats2q;
d605 5
a609 5
   /* Apply the non-linear step of the algorithm chain to convert  */
   /* intermediate spectral coordinate Q to spectral coordinate X. */
   if (spc->spxq2x != 0) {
      if (statq2x = spc->spxq2x(spc->w[0], nspec, sx, sx, x, x, stat)) {
         if (statq2x == 4) {
d612 1
a612 1
            return statq2x;
d618 1
a618 1
      /* Convert X (wavelength) to grism parameter. */
d635 1
a635 1
   /* Convert X to intermediate world coordinate x. */
d646 458
@


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: spc.c,v 3.4 2004/02/11 00:15:03 mcalabre Exp mcalabre $
d74 1
a74 1
/* Map error number to error message. */
@


3.4
log
@WCSLIB 3.4
@
text
@d3 1
a3 1
*   WCSLIB 3.4 - an implementation of the FITS WCS convention.
d29 2
a30 1
*   $Id: spc.c,v 3.3 2003/10/21 08:52:49 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
d29 1
a29 1
*   $Id: spc.c,v 3.2 2003/09/09 04:04:04 mcalabre Exp mcalabre $
@


3.2
log
@WCSLIB 3.2: spcx2q() and spcq2x() no longer return prematurely if some of the
input coordinate values are invalid; test for null spcprm pointer given as
function argument; rationalized function return codes and messages.
@
text
@d3 1
a3 1
*   WCSLIB 3.2 - an implementation of the FITS WCS convention.
d29 1
a29 1
*   $Id: spc.c,v 3.1 2003/04/28 03:50:41 mcalabre Exp mcalabre $
@


3.1
log
@WCSLIB 3.1
In spcprt(), print undefined values as "UNDEFINED".
@
text
@d3 1
a3 1
*   WCSLIB 3.1 - an implementation of the FITS WCS convention.
d29 1
a29 1
*   $Id: spc.c,v 3.0 2003/04/01 04:03:42 mcalabre Exp mcalabre $
d73 2
a74 2
/* Map error number to error message for each function. */
const char *spcset_errmsg[] = {
d76 1
a76 9
   "Invalid spectral parameters"};

const char *spcx2s_errmsg[] = {
   0,
   "Invalid spectral parameters",
   "Invalid value of x"};

const char *spcs2x_errmsg[] = {
   0,
d78 2
a79 1
   "Invalid spectral coordinate"};
d96 2
d196 1
d200 2
d203 1
a203 1
      return 1;
d228 3
a230 2
   if (specx(spc->type, spc->crval, spc->restfrq, spc->restwav, &spx)) {
      return 1;
d251 1
a251 1
      if (!spx.wavetype) return 1;
d256 1
a256 1
         return 1;
d266 1
a266 1
      if (!spx.wavetype) return 1;
d271 1
a271 1
         return 1;
d281 1
a281 1
      if (!spx.wavetype) return 1;
d286 1
a286 1
         return 1;
d296 1
a296 1
      if (!spx.wavetype) return 1;
d301 1
a301 1
         return 1;
d311 1
a311 1
      if (!spx.velotype) return 1;
d316 1
a316 1
         return 1;
d327 1
a327 1
      if (!spx.wavetype) return 1;
d332 1
a332 1
         return 1;
d342 1
a342 1
      if (!spx.velotype) return 1;
d347 1
a347 1
         return 1;
d358 1
a358 1
      if (!spx.velotype) return 1;
d363 1
a363 1
         return 1;
d374 1
a374 1
      if (!spx.wavetype) return 1;
d379 1
a379 1
         return 1;
d389 1
a389 1
      if (!spx.velotype) return 1;
d394 1
a394 1
         return 1;
d404 1
a404 1
      if (!spx.velotype) return 1;
d409 1
a409 1
         return 1;
d419 1
a419 1
      return 1;
d429 1
a429 1
      if (!spx.wavetype) return 1;
d449 1
a449 1
         return 1;
d456 1
a456 1
      if (!spx.wavetype) return 1;
d477 1
a477 1
         return 1;
d484 1
a484 1
      if (!spx.wavetype) return 1;
d505 1
a505 1
         return 1;
d512 1
a512 1
      if (!spx.velotype) return 1;
d535 1
a535 1
         return 1;
d543 1
a543 1
      if (!spx.wavetype) return 1;
d569 1
a569 1
            return 1;
d599 1
a599 1
            return 1;
d637 1
a637 1
      return 1;
d655 1
a655 1
   int status = 0;
d662 1
d664 1
d666 1
a666 1
      if (spcset(spc)) return 1;
d690 7
a696 3
      if (status = spc->spxx2q(spc->w[0], nx, sspec, sspec, spec, spec,
         stat)) {
         return status;
d703 7
a709 3
      if (status = spc->spxq2s(spc->w[0], nx, sspec, sspec, spec, spec,
         stat)) {
         return status;
d713 1
a713 1
   return 0;
d727 2
a728 2
   int status = 0;
   double beta;
d734 1
d736 1
d738 1
a738 1
      if (spcset(spc)) return 1;
d744 6
a749 2
      if (status = spc->spxs2q(spc->w[0], nspec, sspec, sx, spec, x, stat)) {
         return status;
d767 6
a772 2
      if (status = spc->spxq2x(spc->w[0], nspec, sx, sx, x, x, stat)) {
         return status;
d779 11
a789 3
      for (ispec = 0; ispec < nspec; ispec++, xp += sx) {
         beta = asind(*xp/spc->w[5] - spc->w[4]);
         *xp = tand(beta - spc->w[3]);
d798 1
a798 3
      if (*(statp++)) {
         continue;
      }
d804 1
a804 1
   return 0;
@


3.0
log
@WCSLIB 3.0
@
text
@d3 1
a3 1
*   WCSLIB 3.0 - an implementation of the FITS WCS convention.
d29 1
a29 1
*   $Id$
d139 5
a143 1
   printf("      crval: %f\n", spc->crval);
d150 5
a154 1
         printf("  %- 11.4g", spc->pv[i]);
d158 5
a162 1
         printf("  %- 11.4g", spc->pv[i]);
d185 4
a188 4
   printf("    spxx2q: 0x%x\n", (int)spc->spxx2q);
   printf("    spxq2s: 0x%x\n", (int)spc->spxq2s);
   printf("    spxs2q: 0x%x\n", (int)spc->spxs2q);
   printf("    spxq2x: 0x%x\n", (int)spc->spxq2x);
@
