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.22.08.53.12;	author cal103;	state Exp;
branches
	4.2.1.1;
next	4.1;

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

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

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

3.5
date	2004.06.28.04.26.43;	author mcalabre;	state Exp;
branches;
next	0.0;

0.0
date	2004.06.28.04.24.54;	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	2007.06.29.00.58.57;	author cal103;	state Exp;
branches;
next	4.2.1.3;

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

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

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

4.2.1.6
date	2007.08.03.04.34.28;	author cal103;	state Exp;
branches;
next	4.2.1.7;

4.2.1.7
date	2007.08.03.09.01.28;	author cal103;	state Exp;
branches;
next	4.2.1.8;

4.2.1.8
date	2007.12.04.01.01.39;	author cal103;	state Exp;
branches;
next	4.2.1.9;

4.2.1.9
date	2007.12.04.01.22.51;	author cal103;	state Exp;
branches;
next	4.2.1.10;

4.2.1.10
date	2007.12.22.07.28.05;	author cal103;	state Exp;
branches;
next	4.2.1.11;

4.2.1.11
date	2007.12.26.03.04.37;	author cal103;	state Exp;
branches;
next	4.2.1.12;

4.2.1.12
date	2007.12.27.05.14.15;	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	2009.07.22.02.22.17;	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	2010.01.19.03.42.50;	author cal103;	state Exp;
branches;
next	;

4.5.1.1
date	2010.07.16.07.05.31;	author cal103;	state Exp;
branches;
next	4.5.1.2;

4.5.1.2
date	2010.09.28.01.52.45;	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.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.48.09;	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.06.28.04;	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	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.10.1.1
date	2012.02.05.23.42.46;	author cal103;	state Exp;
branches;
next	;

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

4.12.1.1
date	2012.02.29.07.59.10;	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.19.16;	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.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.18.1.2;

4.18.1.2
date	2013.09.29.08.46.10;	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.22.1.2;

4.22.1.2
date	2014.05.04.14.18.47;	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.06.02.52.20;	author mcalabre;	state Exp;
branches;
next	4.25.1.4;

4.25.1.4
date	2015.04.03.01.39.05;	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.19.09.25.58;	author mcalabre;	state Exp;
branches;
next	5.6.1.3;

5.6.1.3
date	2015.06.22.12.38.39;	author mcalabre;	state Exp;
branches;
next	5.6.1.4;

5.6.1.4
date	2015.06.28.14.49.35;	author mcalabre;	state Exp;
branches;
next	;

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

5.7.1.2
date	2015.06.30.06.04.29;	author mcalabre;	state Exp;
branches;
next	5.7.1.3;

5.7.1.3
date	2015.07.05.08.19.49;	author mcalabre;	state Exp;
branches;
next	5.7.1.4;

5.7.1.4
date	2015.07.08.07.19.57;	author mcalabre;	state Exp;
branches;
next	5.7.1.5;

5.7.1.5
date	2015.07.08.10.16.51;	author mcalabre;	state Exp;
branches;
next	;

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

5.8.1.2
date	2015.07.21.08.39.02;	author mcalabre;	state Exp;
branches;
next	;

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

5.9.1.2
date	2015.08.02.07.49.06;	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.11.1.2;

5.11.1.2
date	2015.11.15.01.51.10;	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.12.1.3;

5.12.1.3
date	2016.01.26.08.12.58;	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.24.14.00.52;	author mcalabre;	state Exp;
branches;
next	5.18.1.3;

5.18.1.3
date	2018.07.25.06.25.27;	author mcalabre;	state Exp;
branches;
next	;

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

5.19.1.2
date	2018.10.05.04.44.10;	author mcalabre;	state Exp;
branches;
next	;

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

5.20.1.2
date	2018.10.19.07.30.46;	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.09.08.52.45;	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.05.36.29;	author mcalabre;	state Exp;
branches;
next	6.4.1.3;

6.4.1.3
date	2019.12.16.04.46.38;	author mcalabre;	state Exp;
branches;
next	6.4.1.4;

6.4.1.4
date	2019.12.31.02.29.05;	author mcalabre;	state Exp;
branches;
next	6.4.1.5;

6.4.1.5
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.2.1.2;

7.2.1.2
date	2020.05.27.13.32.40;	author mcalabre;	state Exp;
branches;
next	7.2.1.3;

7.2.1.3
date	2020.05.30.11.51.47;	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.3.1.5;

7.3.1.5
date	2021.01.29.04.09.15;	author mcalabre;	state Exp;
branches;
next	7.3.1.6;

7.3.1.6
date	2021.01.29.09.26.26;	author mcalabre;	state Exp;
branches;
next	;

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

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

7.6.1.1
date	2021.04.13.13.00.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.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.03.08.24.14;	author mcalabre;	state Exp;
branches;
next	7.13.1.3;

7.13.1.3
date	2023.06.15.03.58.10;	author mcalabre;	state Exp;
branches;
next	7.13.1.4;

7.13.1.4
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.1.1.2;

8.1.1.2
date	2023.11.14.06.06.05;	author mcalabre;	state Exp;
branches;
next	8.1.1.3;

8.1.1.3
date	2023.11.14.12.02.38;	author mcalabre;	state Exp;
branches;
next	8.1.1.4;

8.1.1.4
date	2023.11.14.12.39.25;	author mcalabre;	state Exp;
branches;
next	8.1.1.5;

8.1.1.5
date	2023.11.14.13.42.34;	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	2023.11.29.07.42.43;	author mcalabre;	state Exp;
branches;
next	8.2.1.3;

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

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

8.2.1.5
date	2024.05.13.05.14.44;	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.04.13.05.27;	author mcalabre;	state Exp;
branches;
next	8.6.1.3;

8.6.1.3
date	2026.04.10.09.07.46;	author mcalabre;	state Exp;
branches;
next	8.6.1.4;

8.6.1.4
date	2026.04.10.09.23.47;	author mcalabre;	state Exp;
branches;
next	8.6.1.5;

8.6.1.5
date	2026.04.21.06.46.49;	author mcalabre;	state Exp;
branches;
next	8.6.1.6;

8.6.1.6
date	2026.04.22.15.18.58;	author mcalabre;	state Exp;
branches;
next	8.6.1.7;

8.6.1.7
date	2026.05.11.11.25.46;	author mcalabre;	state Exp;
branches;
next	;


desc
@Service functions for the FITS WCS header parsing routines (which are
implemented elsewhere in Flex description files).
@


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: wcshdr.c,v 8.6.1.7 2026/05/11 11:25:46 mcalabre Exp mcalabre $
*===========================================================================*/

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

#include "wcserr.h"
#include "wcsmath.h"
#include "wcsutil.h"
#include "wcshdr.h"
#include "wtbarr.h"
#include "tab.h"
#include "dis.h"
#include "wcs.h"

// Map status return value to message.
const char *wcshdr_errmsg[] = {
  "Success",
  "Null wcsprm pointer passed",
  "Memory allocation failed",
  "Invalid column selection",
  "Fatal error returned by Flex parser",
  "Invalid tabular parameters"};

// Map error returns for lower-level routines.
const int wcshdr_taberr[] = {
  WCSHDRERR_SUCCESS,		//  0: TABERR_SUCCESS
  WCSHDRERR_NULL_POINTER,	//  1: TABERR_NULL_POINTER
  WCSHDRERR_MEMORY,		//  2: TABERR_MEMORY
  WCSHDRERR_BAD_TABULAR_PARAMS	//  3: TABERR_BAD_PARAMS
				//  4: TABERR_BAD_X
				//  5: TABERR_BAD_WORLD
};

static const int WCSSET    =  137;	// Matching wcs.c

static const int DIS_DOTPD = 1024;	// Matching dis.c

// Internal helper functions, not for general use.
static void wcshdo_format(int, int, const double [], char [16]);
static void wcshdo_tpdterm(int, int, char [16]);
static void wcshdo_util(int, const char [], const char [], int, const char [],
  int, int, int, char, int, int [], char [], const char [], int *, char **,
  int *);

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

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

int wcstab(struct wcsprm *wcs)

{
  static const char *function = "wcstab";

  // Pointers to allocated memory.
  char (*PSi_0a)[72] = 0x0, (*PSi_1a)[72] = 0x0, (*PSi_2a)[72] = 0x0;
  int  *PVi_1a = 0x0, *PVi_2a = 0x0, *PVi_3a = 0x0;
  int  *tabidx = 0x0;

  int status = 0;

  if (wcs == 0x0) return WCSHDRERR_NULL_POINTER;
  struct wcserr **err = &(wcs->err);

  // Free memory previously allocated by wcstab().
  if (wcs->flag != -1 && wcs->m_flag == WCSSET) {
    if (wcs->wtb == wcs->m_wtb) wcs->wtb = 0x0;
    if (wcs->tab == wcs->m_tab) wcs->tab = 0x0;

    if (wcs->m_wtb) free(wcs->m_wtb);
    if (wcs->m_tab) {
      for (int j = 0; j < wcs->ntab; j++) {
        tabfree(wcs->m_tab + j);
      }

      free(wcs->m_tab);
    }
  }

  wcs->ntab = 0;
  wcs->nwtb = 0;
  wcs->wtb  = 0x0;
  wcs->tab  = 0x0;


  // Determine the number of -TAB axes.
  int naxis = wcs->naxis;
  int *tabax;
  if (!(tabax = calloc(naxis, sizeof(int)))) {
    return wcserr_set(WCSHDR_ERRMSG(WCSHDRERR_MEMORY));
  }

  int ntabax = 0;
  for (int i = 0; i < naxis; i++) {
    // Null fill.
    wcsutil_null_fill(72, wcs->ctype[i]);

    if (!strcmp(wcs->ctype[i]+4, "-TAB")) {
      tabax[i] = ntabax++;
    } else {
      tabax[i] = -1;
    }
  }

  if (ntabax == 0) {
    // No lookup tables.
    goto cleanup;
  }


  // Collect information from the PSi_ma and PVi_ma keyvalues.
  if (!((PSi_0a = calloc(ntabax, sizeof(char[72]))) &&
        (PVi_1a = calloc(ntabax, sizeof(int)))      &&
        (PVi_2a = calloc(ntabax, sizeof(int)))      &&
        (PSi_1a = calloc(ntabax, sizeof(char[72]))) &&
        (PSi_2a = calloc(ntabax, sizeof(char[72]))) &&
        (PVi_3a = calloc(ntabax, sizeof(int)))      &&
        (tabidx = calloc(ntabax, sizeof(int))))) {
    status = wcserr_set(WCSHDR_ERRMSG(WCSHDRERR_MEMORY));
    goto cleanup;
  }

  for (int itabax = 0; itabax < ntabax; itabax++) {
    // Remember that calloc() zeroes allocated memory.
    PVi_1a[itabax] = 1;
    PVi_2a[itabax] = 1;
    PVi_3a[itabax] = 1;
  }

  for (int ip = 0; ip < wcs->nps; ip++) {
    int itabax = tabax[wcs->ps[ip].i - 1];
    if (itabax >= 0) {
      switch (wcs->ps[ip].m) {
      case 0:
        // EXTNAME.
        strncpy(PSi_0a[itabax], wcs->ps[ip].value, 72);
        wcsutil_null_fill(72, PSi_0a[itabax]);
        break;
      case 1:
        // TTYPEn for coordinate array.
        strncpy(PSi_1a[itabax], wcs->ps[ip].value, 72);
        wcsutil_null_fill(72, PSi_1a[itabax]);
        break;
      case 2:
        // TTYPEn for index vector.
        strncpy(PSi_2a[itabax], wcs->ps[ip].value, 72);
        wcsutil_null_fill(72, PSi_2a[itabax]);
        break;
      default:
        // Undefined (ignored).
        break;
      }
    }
  }

  for (int ip = 0; ip < wcs->npv; ip++) {
    int itabax = tabax[wcs->pv[ip].i - 1];
    if (itabax >= 0) {
      switch (wcs->pv[ip].m) {
      case 1:
        // EXTVER.
        PVi_1a[itabax] = (int)(wcs->pv[ip].value + 0.5);
        break;
      case 2:
        // EXTLEVEL.
        PVi_2a[itabax] = (int)(wcs->pv[ip].value + 0.5);
        break;
      case 3:
        // Table axis number.
        PVi_3a[itabax] = (int)(wcs->pv[ip].value + 0.5);
        break;
      default:
        // Undefined (ignored).
        break;
      }
    }
  }


  // Determine the number of independent tables.
  for (int itabax = 0; itabax < ntabax; itabax++) {
    // These have no defaults.
    if (!PSi_0a[itabax][0] || !PSi_1a[itabax][0]) {
      status = wcserr_set(WCSERR_SET(WCSHDRERR_BAD_TABULAR_PARAMS),
        "Invalid tabular parameters: PSi_0a and PSi_1a must be specified");
      goto cleanup;
    }

    tabidx[itabax] = -1;
    int jtabax;
    for (jtabax = 0; jtabax < itabax; jtabax++) {
      // EXTNAME, EXTVER, EXTLEVEL, and TTYPEn for the coordinate array
      // must match for each axis of a multi-dimensional lookup table.
      if (strcmp(PSi_0a[itabax], PSi_0a[jtabax]) == 0 &&
          strcmp(PSi_1a[itabax], PSi_1a[jtabax]) == 0 &&
          PVi_1a[itabax] == PVi_1a[jtabax] &&
          PVi_2a[itabax] == PVi_2a[jtabax]) {
        tabidx[itabax] = tabidx[jtabax];
        break;
      }
    }

    if (jtabax == itabax) {
      tabidx[itabax] = wcs->ntab;
      wcs->ntab++;
    }
  }

  if (!(wcs->tab = calloc(wcs->ntab, sizeof(struct tabprm)))) {
    status = wcserr_set(WCSHDR_ERRMSG(WCSHDRERR_MEMORY));
    goto cleanup;
  }
  wcs->m_tab = wcs->tab;

  // Table dimensionality; find the largest axis number.
  for (int itabax = 0; itabax < ntabax; itabax++) {
    struct tabprm *tabp = wcs->tab + tabidx[itabax];

    // PVi_3a records the 1-relative table axis number.
    if (PVi_3a[itabax] > tabp->M) {
      tabp->M = PVi_3a[itabax];
    }
  }

  for (int itab = 0; itab < wcs->ntab; itab++) {
    if ((status = tabini(1, wcs->tab[itab].M, 0, wcs->tab + itab))) {
      status = wcserr_set(WCSHDR_ERRMSG(wcshdr_taberr[status]));
      goto cleanup;
    }
  }


  // Copy parameters into the tabprm structs.
  for (int i = 0; i < naxis; i++) {
    int itabax;
    if ((itabax = tabax[i]) < 0) {
      // Not a -TAB axis.
      continue;
    }

    // PVi_3a records the 1-relative table axis number.
    int m = PVi_3a[itabax] - 1;

    struct tabprm *tabp;
    tabp = wcs->tab + tabidx[itabax];
    tabp->map[m] = i;
    tabp->crval[m] = wcs->crval[i];
  }

  // Check for completeness.
  for (int itab = 0; itab < wcs->ntab; itab++) {
    for (int m = 0; m < wcs->tab[itab].M; m++) {
      if (wcs->tab[itab].map[m] < 0) {
        status = wcserr_set(WCSERR_SET(WCSHDRERR_BAD_TABULAR_PARAMS),
          "Invalid tabular parameters: the axis mapping is undefined");
        goto cleanup;
      }
    }
  }


  // Set up for reading the arrays; how many arrays are there?
  for (int itabax = 0; itabax < ntabax; itabax++) {
    // Does this -TAB axis have a non-degenerate index array?
    if (PSi_2a[itabax][0]) {
      wcs->nwtb++;
    }
  }

  // Add one coordinate array for each table.
  wcs->nwtb += wcs->ntab;

  // Allocate memory for structs to be returned.
  if (!(wcs->wtb = calloc(wcs->nwtb, sizeof(struct wtbarr)))) {
    wcs->nwtb = 0;

    status = wcserr_set(WCSHDR_ERRMSG(WCSHDRERR_MEMORY));
    goto cleanup;
  }
  wcs->m_wtb = wcs->wtb;

  // Set pointers for the index and coordinate arrays.
  struct wtbarr *wtbp = wcs->wtb;
  for (int itab = 0; itab < wcs->ntab; itab++) {
    int getcrd = 1;
    for (int itabax = 0; itabax < ntabax; itabax++) {
      if (tabidx[itabax] != itab) continue;

      if (getcrd) {
        // Coordinate array.
        wtbp->i = itabax + 1;
        wtbp->m = PVi_3a[itabax];
        wtbp->kind = 'c';

        strncpy(wtbp->extnam, PSi_0a[itabax], 72);
        wtbp->extver = PVi_1a[itabax];
        wtbp->extlev = PVi_2a[itabax];
        strncpy(wtbp->ttype, PSi_1a[itabax], 72);
        wtbp->row    = 1L;
        wtbp->ndim   = wcs->tab[itab].M + 1;
        wtbp->dimlen = wcs->tab[itab].K;
        wtbp->arrayp = &(wcs->tab[itab].coord);

        // Signal for tabset() to take this memory.
        wcs->tab[itab].m_coord = (double *)0x1;

        wtbp++;
        getcrd = 0;
      }

      if (PSi_2a[itabax][0]) {
        // Index array.
        wtbp->i = itabax + 1;
        wtbp->m = PVi_3a[itabax];
        wtbp->kind = 'i';

        int m = wtbp->m - 1;
        strncpy(wtbp->extnam, PSi_0a[itabax], 72);
        wtbp->extver = PVi_1a[itabax];
        wtbp->extlev = PVi_2a[itabax];
        strncpy(wtbp->ttype, PSi_2a[itabax], 72);
        wtbp->row    = 1L;
        wtbp->ndim   = 1;
        wtbp->dimlen = wcs->tab[itab].K + m;
        wtbp->arrayp = wcs->tab[itab].index + m;

        // Signal for tabset() to take this memory.
        wcs->tab[itab].m_indxs[m] = (double *)0x1;

        wtbp++;
      }
    }
  }

cleanup:
  if (tabax)  free(tabax);
  if (tabidx) free(tabidx);
  if (PSi_0a) free(PSi_0a);
  if (PVi_1a) free(PVi_1a);
  if (PVi_2a) free(PVi_2a);
  if (PSi_1a) free(PSi_1a);
  if (PSi_2a) free(PSi_2a);
  if (PVi_3a) free(PVi_3a);

  if (status) {
    if (wcs->tab) free(wcs->tab);
    if (wcs->wtb) free(wcs->wtb);
  }

  return status;
}

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

int wcsidx(int nwcs, struct wcsprm **wcs, int alts[27])

{
  for (int a = 0; a < 27; a++) {
    alts[a] = -1;
  }

  if (wcs == 0x0) {
    return WCSHDRERR_NULL_POINTER;
  }

  struct wcsprm *wcsp = *wcs;
  for (int iwcs = 0; iwcs < nwcs; iwcs++, wcsp++) {
    if (wcsp->colnum || wcsp->colax[0]) continue;

    int a;
    if (wcsp->alt[0] == ' ') {
      a = 0;
    } else {
      a = wcsp->alt[0] - 'A' + 1;
    }

    alts[a] = iwcs;
  }

  return 0;
}

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

int wcsbdx(int nwcs, struct wcsprm **wcs, int type, short alts[1000][28])

{
  // End of the array.
  short *ipend = alts[0] + (ptrdiff_t)(28*1000);
  for (short *ip = alts[0]; ip < ipend; ip++) {
    *ip = -1;
  }

  for (int icol = 0; icol < 1000; icol++) {
    alts[icol][27] = 0;
  }

  if (wcs == 0x0) {
    return WCSHDRERR_NULL_POINTER;
  }

  struct wcsprm *wcsp = *wcs;
  for (short iwcs = 0; iwcs < (short)nwcs; iwcs++, wcsp++) {
    int a;
    if (wcsp->alt[0] == ' ') {
      a = 0;
    } else {
      a = wcsp->alt[0] - 'A' + 1;
    }

    if (type) {
      // Pixel list.
      if (wcsp->colax[0]) {
        for (int i = 0; i < wcsp->naxis; i++) {
          alts[wcsp->colax[i]][a] = iwcs;
          alts[wcsp->colax[i]][27]++;
        }
      } else if (!wcsp->colnum) {
        alts[0][a] = iwcs;
        alts[0][27]++;
      }

    } else {
      // Binary table image array.
      if (wcsp->colnum) {
        alts[wcsp->colnum][a] = iwcs;
        alts[wcsp->colnum][27]++;
      } else if (!wcsp->colax[0]) {
        alts[0][a] = iwcs;
        alts[0][27]++;
      }
    }
  }

  return 0;
}

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

int wcsvfree(int *nwcs, struct wcsprm **wcs)

{
  int status = 0;

  if (wcs == 0x0) {
    return WCSHDRERR_NULL_POINTER;
  }

  struct wcsprm *wcsp = *wcs;
  for (int a = 0; a < *nwcs; a++, wcsp++) {
    status |= wcsfree(wcsp);
  }

  free(*wcs);

  *nwcs = 0;
  *wcs = 0x0;

  return status;
}

//----------------------------------------------------------------------------
// Matching the definitions in dis.c.
#define I_DTYPE   0	// Distortion type code.
#define I_NIPARM  1	// Full (allocated) length of iparm[].
#define I_NDPARM  2	// No. of parameters in dparm[], excl. work space.
#define I_TPDNCO  3	// No. of TPD coefficients, forward...
#define I_TPDINV  4	// ...and inverse.
#define I_TPDAUX  5	// True if auxiliary variables are used.
#define I_TPDRAD  6	// True if the radial variable is used.

int wcshdo(int ctrl, struct wcsprm *wcs, int *nkeyrec, char **header)

// ::: CUBEFACE and STOKES handling?

{
  static const char *function = "wcshdo";

  const char axid[] = "xyxuvu", *cp;
  const int  nTPD[] = {1, 4, 7, 12, 17, 24, 31, 40, 49, 60};

  *nkeyrec = 0;
  *header  = 0x0;

  if (wcs == 0x0) return WCSHDRERR_NULL_POINTER;
  struct wcserr **err = &(wcs->err);

  int status = 0;
  if (abs(wcs->flag) != WCSSET) {
    if ((status = wcsset(wcs))) return status;
  }

  int naxis;
  if ((naxis = wcs->naxis) == 0) {
    return 0;
  }


  // These are mainly for convenience.
  char alt = wcs->alt[0];
  if (alt == ' ') alt = '\0';
  int colnum = wcs->colnum;
  int *colax = wcs->colax;

  int primage = 0;
  int bintab  = 0;
  int pixlist = 0;
  if (colnum) {
    bintab  = 1;
  } else if (colax[0]) {
    pixlist = 1;
  } else {
    primage = 1;
  }


  // Initialize floating point format control.
  char format[16];
  *format = '\0';
  if (ctrl & WCSHDO_P17) {
    strncpy(format, "% 20.17G", 16);
  } else if (ctrl & WCSHDO_P16) {
    strncpy(format, "% 20.16G", 16);
  } else if (ctrl & WCSHDO_P15) {
    strncpy(format, "% 20.15G", 16);
  } else if (ctrl & WCSHDO_P14) {
    strncpy(format, "% 20.14G", 16);
  } else if (ctrl & WCSHDO_P13) {
    strncpy(format, "% 20.13G", 16);
  } else if (ctrl & WCSHDO_P12) {
    strncpy(format, "%20.12G", 16);
  }

  if (*format && (ctrl & WCSHDO_EFMT)) {
    if (format[6] == 'G') {
      format[6] = 'E';
    } else {
      format[7] = 'E';
    }
  }

  int dofmt = (*format == '\0');

  char keyword[16],  *kwe = keyword  + 16;
  char keyvalue[96], *kve = keyvalue + 96;
  char comment[128], *cme = comment + 128;


  // WCS dimension.
  if (!pixlist) {
    snprintf(keyvalue, 96, "%20d", naxis);
    wcshdo_util(ctrl, "WCSAXES", "WCAX", 0, 0x0, 0, 0, 0, alt, colnum, colax,
      keyvalue, "Number of coordinate axes", nkeyrec, header, &status);
  }

  // Reference pixel coordinates.
  if (dofmt) wcshdo_format('G', naxis, wcs->crpix, format);
  for (int j = 0; j < naxis; j++) {
    wcsutil_double2str(keyvalue, 96, format, wcs->crpix[j]);
    wcshdo_util(ctrl, "CRPIX", "CRP", WCSHDO_CRPXna, "CRPX", 0, j+1, 0, alt,
      colnum, colax, keyvalue, "Pixel coordinate of reference point", nkeyrec,
      header, &status);
  }

  // Linear transformation matrix.
  if (dofmt) wcshdo_format('G', naxis*naxis, wcs->pc, format);
  int k = 0;
  for (int i = 0; i < naxis; i++) {
    for (int j = 0; j < naxis; j++, k++) {
      if (i == j) {
        if (wcs->pc[k] == 1.0) continue;
      } else {
        if (wcs->pc[k] == 0.0) continue;
      }

      wcsutil_double2str(keyvalue, 96, format, wcs->pc[k]);
      wcshdo_util(ctrl, "PC", bintab ? "PC" : "P", WCSHDO_TPCn_ka,
        bintab ? 0x0 : "PC", i+1, j+1, 0, alt, colnum, colax,
        keyvalue, "Coordinate transformation matrix element",
        nkeyrec, header, &status);
    }
  }

  // Coordinate increment at reference point.
  if (dofmt) wcshdo_format('G', naxis, wcs->cdelt, format);
  for (int i = 0; i < naxis; i++) {
    wcsutil_double2str(keyvalue, 96, format, wcs->cdelt[i]);
    comment[0] = '\0';
    if (wcs->cunit[i][0]) snprintf(comment, 128, "[%s] ", wcs->cunit[i]);
    char *cm = comment + strlen(comment);
    size_t csize = cme - cm;
    strncpy(cm, "Coordinate increment at reference point", csize);
    wcshdo_util(ctrl, "CDELT", "CDE", WCSHDO_CRPXna, "CDLT", i+1, 0, 0, alt,
      colnum, colax, keyvalue, comment, nkeyrec, header, &status);
  }

  // Units of coordinate increment and reference value.
  for (int i = 0; i < naxis; i++) {
    if (wcs->cunit[i][0] == '\0') continue;

    snprintf(keyvalue, 96, "'%s'", wcs->cunit[i]);
    wcshdo_util(ctrl, "CUNIT", "CUN", WCSHDO_CRPXna, "CUNI", i+1, 0, 0, alt,
      colnum, colax, keyvalue, "Units of coordinate increment and value",
      nkeyrec, header, &status);
  }

  // May need to alter ctype for particular distortions so do basic checks
  // now.  Note that SIP, TPV, DSS, TNX, and ZPX are restricted to exactly
  // two axes and cannot coexist with other distortion types.
  char   tpdsrc[24];
  int    dosip = 0, dotpd = 0, dotpv = 0;
  struct disprm *dis;

  if ((dis = wcs->lin.dispre)) {
    for (int i = 0; i < naxis; i++) {
      if (strcmp(dis->dtype[i], "SIP") == 0) {
        // Simple Imaging Polynomial (SIP).  Write it in its native form
        // if possible, unless specifically requested to write it as TPD.
        dotpd = (dis->iparm[i][I_DTYPE] & DIS_DOTPD);

        if (!dotpd) {
          if (alt ||
              dis->Nhat[0]      != 2 ||
              dis->Nhat[1]      != 2 ||
              dis->axmap[0][0]  != 0 ||
              dis->axmap[0][1]  != 1 ||
              dis->axmap[1][0]  != 0 ||
              dis->axmap[1][1]  != 1 ||
              dis->offset[0][0] != wcs->crpix[0] ||
              dis->offset[0][1] != wcs->crpix[1] ||
              dis->offset[1][0] != wcs->crpix[0] ||
              dis->offset[1][1] != wcs->crpix[1] ||
              dis->scale[0][0]  != 1.0 ||
              dis->scale[0][1]  != 1.0 ||
              dis->scale[1][0]  != 1.0 ||
              dis->scale[1][1]  != 1.0) {
            // Must have been read as a 'SIP' distortion, CPDISja = 'SIP'.
            // Cannot be written as native SIP so write it as TPD.
            dotpd = DIS_DOTPD;
          }

          if (strncmp(wcs->ctype[0], "RA---TAN", 8) != 0 ||
              strncmp(wcs->ctype[1], "DEC--TAN", 8) != 0) {
            // Must have been permuted by wcssub().
            // Native SIP doesn't have axis mapping so write it as TPD.
            dotpd = DIS_DOTPD;
          }

          if (dotpd) {
            strncpy(tpdsrc, "SIP coordinates", 24);
          } else {
            dosip = 1;
          }
        }

        break;
      }
    }
  }

  if ((dis = wcs->lin.disseq)) {
    for (int i = 0; i < naxis; i++) {
      if (strcmp(dis->dtype[i], "TPV") == 0) {
        // TPV "projection".  Write it in its native form if possible,
        // unless specifically requested to write it as TPD.
        dotpd = (dis->iparm[i][I_DTYPE] & DIS_DOTPD);

        if (!dotpd) {;
          if (dis->axmap[wcs->lng][0] != wcs->lng ||
              dis->axmap[wcs->lng][1] != wcs->lat ||
              dis->axmap[wcs->lat][0] != wcs->lat ||
              dis->axmap[wcs->lat][1] != wcs->lng ||
              dis->offset[wcs->lng][wcs->lng] != 0.0 ||
              dis->offset[wcs->lng][wcs->lat] != 0.0 ||
              dis->offset[wcs->lat][wcs->lng] != 0.0 ||
              dis->offset[wcs->lat][wcs->lat] != 0.0 ||
              dis->scale[wcs->lng][wcs->lng]  != 1.0 ||
              dis->scale[wcs->lng][wcs->lat]  != 1.0 ||
              dis->scale[wcs->lat][wcs->lng]  != 1.0 ||
              dis->scale[wcs->lat][wcs->lat]  != 1.0) {
            // Must have been read as a 'TPV' distortion, CPDISja = 'TPV'.
            // Cannot be written as native TPV so write it as TPD.
            dotpd = DIS_DOTPD;
          }

          if (dotpd) {
            strncpy(tpdsrc, "TPV \"projection\"", 24);
          } else {
            dotpv = 1;
          }
        }

        break;

      } else if (strcmp(dis->dtype[i], "DSS") == 0) {
        // Always written as TPD.
        dotpd = DIS_DOTPD;
        strncpy(tpdsrc, dis->dtype[i], 24);

      } else if (strncmp(dis->dtype[i], "WAT", 3) == 0) {
        // Always written as TPD.
        dotpd = DIS_DOTPD;
        strncpy(tpdsrc, dis->dtype[i]+4, 24);

        if (strcmp(dis->dtype[i], "DSS") == 0) {
          strncpy(tpdsrc, wcs->wcsname, 24);
        } else {
          char *tp = tpdsrc + strlen(tpdsrc);
          size_t tsize = (tpdsrc + 24) - tp;
          strncpy(tp, " \"projection\"", tsize);
        }

        break;
      }
    }
  }

  // Coordinate type.
  for (int i = 0; i < naxis; i++) {
    if (wcs->ctype[i][0] == '\0') continue;

    snprintf(keyvalue, 96, "'%s'", wcs->ctype[i]);
    strncpy(comment, "Coordinate type code", 128);

    char *ctypei = keyvalue + 1;
    if (i == wcs->lng || i == wcs->lat) {
      // Alter ctype for particular distortions.
      if (dosip) {
        // It could have come in as CPDISja = 'SIP'.
        strncpy(ctypei+8, "-SIP'", 6);
      } else if (dotpv) {
        // Reinstate projection code edited by wcsset().
        strncpy(ctypei+4, "-TPV'", 6);
      }

      if (strncmp(ctypei+8, "-SIP", 4) == 0) {
        strncpy(comment, "TAN (gnomonic) projection + SIP distortions", 128);

      } else if (strncmp(ctypei+4, "-TPV", 4) == 0) {
        strncpy(comment, "TAN (gnomonic) projection + distortions", 128);

      } else {
        if (strncmp(ctypei, "RA--", 4) == 0) {
          strncpy(comment, "Right ascension, ", 128);

        } else if (strncmp(ctypei, "DEC-", 4) == 0) {
          strncpy(comment, "Declination, ", 128);

        } else if (strncmp(ctypei+1, "LON", 3) == 0 ||
                   strncmp(ctypei+1, "LAT", 3) == 0) {
          ctypei[0] = (char)toupper((unsigned char)ctypei[0]);

          switch (ctypei[0]) {
          case 'G':
            strncpy(comment, "Galactic l", 128);
            break;
          case 'E':
            strncpy(comment, "Ecliptic l", 128);
            break;
          case 'H':
            strncpy(comment, "Helioecliptic l", 128);
            break;
          case 'S':
            strncpy(comment, "Supergalactic l", 128);
            break;
          default:
            // User-defined coordinate system.
            strncpy(comment, "L", 128);
            break;
          }

          char *cm = comment + strlen(comment);
          size_t csize = cme - cm;
          if (i == wcs->lng) {
            strncpy(cm, "ongitude, ", csize);
          } else {
            strncpy(cm, "atitude, ", csize);
          }
        }

        char *cm = comment + strlen(comment);
        size_t csize = cme - cm;
        strncpy(cm, wcs->cel.prj.name, csize);

        cm += strlen(cm);
        csize = cme - cm;
        strncpy(cm, " projection", csize);
      }

    } else if (i == wcs->spec) {
      char ptype, xtype;
      spctyp(wcs->ctype[i], 0x0, 0x0, comment, 0x0, &ptype, &xtype, 0x0);

      char *cm = comment + strlen(comment);
      size_t csize = cme - cm;

      if (ptype == xtype) {
        strncpy(cm, " (linear)", csize);
      } else {
        switch (xtype) {
        case 'F':
          strncpy(cm, " (linear in frequency)", csize);
          break;
        case 'V':
          strncpy(cm, " (linear in velocity)", csize);
          break;
        case 'W':
          strncpy(cm, " (linear in wavelength)", csize);
          break;
        default:
          strncpy(cm, " (not recognised)", csize);
          break;
        }
      }
    }

    wcshdo_util(ctrl, "CTYPE", "CTY", WCSHDO_CRPXna, "CTYP", i+1, 0, 0, alt,
      colnum, colax, keyvalue, comment, nkeyrec, header, &status);
  }

  // Coordinate value at reference point.
  for (int i = 0; i < naxis; i++) {
    if (dofmt) wcshdo_format('G', 1, wcs->crval+i, format);
    wcsutil_double2str(keyvalue, 96, format, wcs->crval[i]);
    comment[0] = '\0';
    if (wcs->cunit[i][0]) snprintf(comment, 128, "[%s] ", wcs->cunit[i]);
    char *cm = comment + strlen(comment);
    size_t csize = cme - cm;
    strncpy(cm, "Coordinate value at reference point", csize);
    wcshdo_util(ctrl, "CRVAL", "CRV", WCSHDO_CRPXna, "CRVL", i+1, 0, 0, alt,
      colnum, colax, keyvalue, comment, nkeyrec, header, &status);
  }

  // Parameter values.
  if (dofmt) strncpy(format, "%20.12G", 16);
  for (int k = 0; k < wcs->npv; k++) {
    wcsutil_double2str(keyvalue, 96, format, (wcs->pv[k]).value);
    if ((wcs->pv[k]).i == (wcs->lng + 1)) {
      switch ((wcs->pv[k]).m) {
      case 1:
        strncpy(comment, "[deg] Native longitude of the reference point",
          128);
        break;
      case 2:
        strncpy(comment, "[deg] Native latitude  of the reference point",
          128);
        break;
      case 3:
        if (primage) {
          snprintf(keyword, 16, "LONPOLE%c", alt);
        } else if (bintab) {
          snprintf(keyword, 16, "LONP%d%c", colnum, alt);
        } else {
          snprintf(keyword, 16, "LONP%d%c", colax[(wcs->pv[k]).i - 1], alt);
        }
        snprintf(comment, 128, "[deg] alias for %s (has precedence)",
          keyword);
        break;
      case 4:
        if (primage) {
          snprintf(keyword, 16, "LATPOLE%c", alt);
        } else if (bintab) {
          snprintf(keyword, 16, "LATP%d%c", colnum, alt);
        } else {
          snprintf(keyword, 16, "LATP%d%c", colax[(wcs->pv[k]).i - 1], alt);
        }
        snprintf(comment, 128, "[deg] alias for %s (has precedence)",
          keyword);
        break;
      default:;
        char *cm = comment + strlen(comment);
        size_t csize = cme - cm;
        strncpy(cm, " (not recognised)", csize);
        break;
      }
    } else if ((wcs->pv[k]).i == (wcs->lat + 1)) {
      snprintf(comment, 128, "%s projection parameter", wcs->cel.prj.code);
    } else {
      strncpy(comment, "Coordinate transformation parameter", 128);
    }

    wcshdo_util(ctrl, "PV", "V", WCSHDO_PVn_ma, "PV", wcs->pv[k].i, -1,
      wcs->pv[k].m, alt, colnum, colax, keyvalue, comment, nkeyrec, header,
      &status);
  }

  for (int k = 0; k < wcs->nps; k++) {
    snprintf(keyvalue, 96, "'%s'", (wcs->ps[k]).value);
    wcshdo_util(ctrl, "PS", "S", WCSHDO_PVn_ma, "PS", wcs->ps[k].i, -1,
      wcs->ps[k].m, alt, colnum, colax, keyvalue,
      "Coordinate transformation parameter", nkeyrec, header, &status);
  }

  // Celestial and spectral transformation parameters.
  if (!undefined(wcs->lonpole)) {
    wcsutil_double2str(keyvalue, 96, format, wcs->lonpole);
    wcshdo_util(ctrl, "LONPOLE", "LONP", 0, 0x0, 0, 0, 0, alt, colnum, colax,
      keyvalue, "[deg] Native longitude of celestial pole", nkeyrec, header,
      &status);
  }

  if (!undefined(wcs->latpole)) {
    wcsutil_double2str(keyvalue, 96, format, wcs->latpole);
    wcshdo_util(ctrl, "LATPOLE", "LATP", 0, 0x0, 0, 0, 0, alt, colnum, colax,
      keyvalue, "[deg] Native latitude of celestial pole", nkeyrec, header,
      &status);
  }

  if (wcs->restfrq != 0.0) {
    wcsutil_double2str(keyvalue, 96, format, wcs->restfrq);
    wcshdo_util(ctrl, "RESTFRQ", "RFRQ", 0, 0x0, 0, 0, 0, alt, colnum, colax,
      keyvalue, "[Hz] Line rest frequency", nkeyrec, header, &status);
  }

  if (wcs->restwav != 0.0) {
    wcsutil_double2str(keyvalue, 96, format, wcs->restwav);
    wcshdo_util(ctrl, "RESTWAV", "RWAV", 0, 0x0, 0, 0, 0, alt, colnum, colax,
      keyvalue, "[Hz] Line rest wavelength", nkeyrec, header, &status);
  }

  // - - - - - - - - - - - - - - - - -  Auxiliary coordinate axis information.
  char timeunit[16];
  snprintf(timeunit, 16, "%.15s", wcs->timeunit[0] ? wcs->timeunit : "s");

  // Coordinate axis title.
  if (wcs->cname) {
    for (int i = 0; i < naxis; i++) {
      if (wcs->cname[i][0] == '\0') continue;

      snprintf(keyvalue, 96, "'%s'", wcs->cname[i]);
      wcshdo_util(ctrl, "CNAME", "CNA", WCSHDO_CNAMna, "CNAM", i+1, 0, 0,
        alt, colnum, colax, keyvalue, "Axis name for labelling purposes",
        nkeyrec, header, &status);
    }
  }

  // Random error in coordinate.
  if (wcs->crder) {
    for (int i = 0; i < naxis; i++) {
      if (undefined(wcs->crder[i])) continue;

      wcsutil_double2str(keyvalue, 96, format, wcs->crder[i]);
      comment[0] = '\0';
      if (wcs->cunit[i][0]) snprintf(comment, 128, "[%s] ", wcs->cunit[i]);
      char *cm = comment + strlen(comment);
      size_t csize = cme - cm;
      strncpy(cm, "Random error in coordinate", csize);
      wcshdo_util(ctrl, "CRDER", "CRD", WCSHDO_CNAMna, "CRDE", i+1, 0, 0,
        alt, colnum, colax, keyvalue, comment, nkeyrec, header, &status);
    }
  }

  // Systematic error in coordinate.
  if (wcs->csyer) {
    for (int i = 0; i < naxis; i++) {
      if (undefined(wcs->csyer[i])) continue;

      wcsutil_double2str(keyvalue, 96, format, wcs->csyer[i]);
      comment[0] = '\0';
      if (wcs->cunit[i][0]) snprintf(comment, 128, "[%s] ", wcs->cunit[i]);
      char *cm = comment + strlen(comment);
      size_t csize = cme - cm;
      strncpy(cm, "Systematic error in coordinate", csize);
      wcshdo_util(ctrl, "CSYER", "CSY", WCSHDO_CNAMna, "CSYE", i+1, 0, 0,
        alt, colnum, colax, keyvalue, comment, nkeyrec, header, &status);
    }
  }

  // Time at zero point of phase axis.
  if (wcs->czphs) {
    for (int i = 0; i < naxis; i++) {
      if (undefined(wcs->czphs[i])) continue;

      wcsutil_double2str(keyvalue, 96, format, wcs->czphs[i]);
      snprintf(comment, 128, "[%s] Time at zero point of phase axis",
        timeunit);
      wcshdo_util(ctrl, "CZPHS", "CZP", WCSHDO_CNAMna, "CZPH", i+1, 0, 0,
        alt, colnum, colax, keyvalue, comment, nkeyrec, header, &status);
    }
  }

  // Period of phase axis.
  if (wcs->cperi) {
    for (int i = 0; i < naxis; i++) {
      if (undefined(wcs->cperi[i])) continue;

      wcsutil_double2str(keyvalue, 96, format, wcs->cperi[i]);
      snprintf(comment, 128, "[%s] Period of phase axis", timeunit);
      wcshdo_util(ctrl, "CPERI", "CPR", WCSHDO_CNAMna, "CPER", i+1, 0, 0,
        alt, colnum, colax, keyvalue, comment, nkeyrec, header, &status);
    }
  }

  // - - - - - - - - - - - - - - - - - - - - - - - -  Coordinate system title.

  // Coordinate system title.
  if (wcs->wcsname[0]) {
    snprintf(keyvalue, 96, "'%s'", wcs->wcsname);
    if (bintab) {
      wcshdo_util(ctrl, "WCSNAME", "WCSN", 0, 0x0, 0, 0, 0, alt, colnum,
        colax, keyvalue, "Coordinate system title", nkeyrec, header, &status);
    } else {
      // TWCS was a mistake.
      wcshdo_util(ctrl, "WCSNAME", "TWCS", WCSHDO_WCSNna, "WCSN", 0, 0, 0,
        alt, colnum, colax, keyvalue, "Coordinate system title",
        nkeyrec, header, &status);
    }
  }

  // - - - - - - - - - - - - - - - - -  Time reference system and measurement.

  // Time scale.
  if (wcs->timesys[0]) {
    snprintf(keyvalue, 96, "'%s'", wcs->timesys);
    wcshdo_util(ctrl, "TIMESYS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "Time scale", nkeyrec, header, &status);
  }

  // Time reference position.
  if (wcs->trefpos[0]) {
    snprintf(keyvalue, 96, "'%s'", wcs->trefpos);
    wcshdo_util(ctrl, "TREFPOS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "Time reference position", nkeyrec, header, &status);
  }

  // Time reference direction.
  if (wcs->trefdir[0]) {
    snprintf(keyvalue, 96, "'%s'", wcs->trefdir);
    wcshdo_util(ctrl, "TREFDIR", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "Time reference direction", nkeyrec, header, &status);
  }

  // Ephemerides used for pathlength delay calculation.
  if (wcs->plephem[0]) {
    snprintf(keyvalue, 96, "'%s'", wcs->plephem);
    wcshdo_util(ctrl, "PLEPHEM", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "Ephemerides used for pathlength delays", nkeyrec, header,
      &status);
  }

  // Time units.
  if (wcs->timeunit[0]) {
    snprintf(keyvalue, 96, "'%s'", wcs->timeunit);
    wcshdo_util(ctrl, "TIMEUNIT", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "Time units", nkeyrec, header, &status);
  }

  // Fiducial (reference) time.
  if (wcs->mjdref[0] == 0.0 && wcs->mjdref[1] == 0.0) {
    // MJD of fiducial time (simplified if it takes its default value).
    wcsutil_double2str(keyvalue, 96, format, 0.0);
    wcshdo_util(ctrl, "MJDREF", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "[d] MJD of fiducial time", nkeyrec, header, &status);

  } else {
    // ISO-8601 fiducial time.
    if (wcs->dateref[0]) {
      snprintf(keyvalue, 96, "'%s'", wcs->dateref);
      wcshdo_util(ctrl, "DATEREF", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        keyvalue, "ISO-8601 fiducial time", nkeyrec, header, &status);
    }

    if (wcs->mjdref[1] == 0.0) {
      // MJD of fiducial time (no fractional part).
      if (!undefined(wcs->mjdref[0])) {
        wcsutil_double2str(keyvalue, 96, format, wcs->mjdref[0]);
        wcshdo_util(ctrl, "MJDREF", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
          keyvalue, "[d] MJD of fiducial time", nkeyrec, header, &status);
      }

    } else {
      // MJD of fiducial time, integer part.
      if (!undefined(wcs->mjdref[0])) {
        wcsutil_double2str(keyvalue, 96, format, wcs->mjdref[0]);
        wcshdo_util(ctrl, "MJDREFI", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
          keyvalue, "[d] MJD of fiducial time, integer part", nkeyrec,
          header, &status);
      }

      // MJD of fiducial time, fractional part.
      if (!undefined(wcs->mjdref[1])) {
        wcsutil_double2str(keyvalue, 96, format, wcs->mjdref[1]);
        wcshdo_util(ctrl, "MJDREFF", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
          keyvalue, "[d] MJD of fiducial time, fractional part", nkeyrec,
          header, &status);
      }
    }
  }

  // Clock correction.
  if (!undefined(wcs->timeoffs)) {
    wcsutil_double2str(keyvalue, 96, format, wcs->timeoffs);
    snprintf(comment, 128, "[%s] Clock correction", timeunit);
    wcshdo_util(ctrl, "TIMEOFFS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, comment, nkeyrec, header, &status);
  }

  // - - - - - - - - - - - - - - - - - - - - -  Data timestamps and durations.

  // ISO-8601 time of observation.
  if (wcs->dateobs[0]) {
    snprintf(keyvalue, 96, "'%s'", wcs->dateobs);
    strncpy(comment, "ISO-8601 time of observation", 128);

    if (ctrl & 1) {
      // Allow DOBSn.
      wcshdo_util(ctrl, "DATE-OBS", "DOBS", WCSHDO_DOBSn, 0x0, 0, 0, 0, ' ',
        colnum, colax, keyvalue, comment, nkeyrec, header, &status);
    } else {
      // Force DATE-OBS.
      wcshdo_util(ctrl, "DATE-OBS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        keyvalue, comment, nkeyrec, header, &status);
    }
  }

  // MJD of observation.
  if (!undefined(wcs->mjdobs)) {
    wcsutil_double2str(keyvalue, 96, format, wcs->mjdobs);
    wcshdo_util(ctrl, "MJD-OBS", "MJDOB", 0, 0x0, 0, 0, 0, ' ', colnum, colax,
      keyvalue, "[d] MJD of observation", nkeyrec, header, &status);
  }

  // Julian epoch of observation.
  if (!undefined(wcs->jepoch)) {
    wcsutil_double2str(keyvalue, 96, format, wcs->jepoch);
    wcshdo_util(ctrl, "JEPOCH", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "[a] Julian epoch of observation", nkeyrec, header, &status);
  }

  // Besselian epoch of observation.
  if (!undefined(wcs->bepoch)) {
    wcsutil_double2str(keyvalue, 96, format, wcs->bepoch);
    wcshdo_util(ctrl, "BEPOCH", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "[a] Besselian epoch of observation", nkeyrec, header,
      &status);
  }

  // ISO-8601 time at start of observation.
  if (wcs->datebeg[0]) {
    snprintf(keyvalue, 96, "'%s'", wcs->datebeg);
    wcshdo_util(ctrl, "DATE-BEG", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "ISO-8601 time at start of observation", nkeyrec, header,
      &status);
  }

  // MJD at start of observation.
  if (!undefined(wcs->mjdbeg)) {
    wcsutil_double2str(keyvalue, 96, format, wcs->mjdbeg);
    wcshdo_util(ctrl, "MJD-BEG", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "[d] MJD at start of observation", nkeyrec, header, &status);
  }

  // Time elapsed at start since fiducial time.
  if (!undefined(wcs->tstart)) {
    wcsutil_double2str(keyvalue, 96, format, wcs->tstart);
    snprintf(comment, 128, "[%s] Time elapsed since fiducial time at start",
      timeunit);
    wcshdo_util(ctrl, "TSTART", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, comment, nkeyrec, header, &status);
  }

  // ISO-8601 time at midpoint of observation.
  if (wcs->dateavg[0]) {
    snprintf(keyvalue, 96, "'%s'", wcs->dateavg);
    wcshdo_util(ctrl, "DATE-AVG", "DAVG", 0, 0x0, 0, 0, 0, ' ', colnum, colax,
      keyvalue, "ISO-8601 time at midpoint of observation", nkeyrec, header,
      &status);
  }

  // MJD at midpoint of observation.
  if (!undefined(wcs->mjdavg)) {
    wcsutil_double2str(keyvalue, 96, format, wcs->mjdavg);
    wcshdo_util(ctrl, "MJD-AVG", "MJDA", 0, 0x0, 0, 0, 0, ' ', colnum, colax,
      keyvalue, "[d] MJD at midpoint of observation", nkeyrec, header,
      &status);
  }

  // ISO-8601 time at end of observation.
  if (wcs->dateend[0]) {
    snprintf(keyvalue, 96, "'%s'", wcs->dateend);
    wcshdo_util(ctrl, "DATE-END", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "ISO-8601 time at end of observation", nkeyrec, header,
      &status);
  }

  // MJD at end of observation.
  if (!undefined(wcs->mjdend)) {
    wcsutil_double2str(keyvalue, 96, format, wcs->mjdend);
    wcshdo_util(ctrl, "MJD-END", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "[d] MJD at end of observation", nkeyrec, header, &status);
  }

  // Time elapsed at end since fiducial time.
  if (!undefined(wcs->tstop)) {
    wcsutil_double2str(keyvalue, 96, format, wcs->tstop);
    snprintf(comment, 128, "[%s] Time elapsed since fiducial time at end",
      timeunit);
    wcshdo_util(ctrl, "TSTOP", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, comment, nkeyrec, header, &status);
  }

  // Exposure (integration) time.
  if (!undefined(wcs->xposure)) {
    wcsutil_double2str(keyvalue, 96, format, wcs->xposure);
    snprintf(comment, 128, "[%s] Exposure (integration) time", timeunit);
    wcshdo_util(ctrl, "XPOSURE", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, comment, nkeyrec, header, &status);
  }

  // Elapsed time (start to stop).
  if (!undefined(wcs->telapse)) {
    wcsutil_double2str(keyvalue, 96, format, wcs->telapse);
    snprintf(comment, 128, "[%s] Elapsed time (start to stop)", timeunit);
    wcshdo_util(ctrl, "TELAPSE", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, comment, nkeyrec, header, &status);
  }

  // - - - - - - - - - - - - - - - - - - - - - - - - - - - -  Timing accuracy.

  // Systematic error in time measurements.
  if (!undefined(wcs->timsyer)) {
    wcsutil_double2str(keyvalue, 96, format, wcs->timsyer);
    snprintf(comment, 128, "[%s] Systematic error in time measurements",
      timeunit);
    wcshdo_util(ctrl, "TIMSYER", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, comment, nkeyrec, header, &status);
  }

  // Relative error in time measurements.
  if (!undefined(wcs->timrder)) {
    wcsutil_double2str(keyvalue, 96, format, wcs->timrder);
    snprintf(comment, 128, "[%s] Relative error in time measurements",
      timeunit);
    wcshdo_util(ctrl, "TIMRDER", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, comment, nkeyrec, header, &status);
  }

  // Time resolution.
  if (!undefined(wcs->timedel)) {
    wcsutil_double2str(keyvalue, 96, format, wcs->timedel);
    snprintf(comment, 128, "[%s] Time resolution", timeunit);
    wcshdo_util(ctrl, "TIMEDEL", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, comment, nkeyrec, header, &status);
  }

  // Reference position of timestamp in binned data.
  if (!undefined(wcs->timepixr)) {
    wcsutil_double2str(keyvalue, 96, format, wcs->timepixr);
    wcshdo_util(ctrl, "TIMEPIXR", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "Reference position of timestamp in binned data", nkeyrec,
      header, &status);
  }

  // - - - - - - - - - - - - - - - - - -  Spatial & celestial reference frame.

  // Observatory coordinates.
  if (!undefined(wcs->obsgeo[0]) &&
      !undefined(wcs->obsgeo[1]) &&
      !undefined(wcs->obsgeo[2])) {

    char obsgeo[16] = "OBSGEO-?", obsg[8] = "OBSG?", xyz[] = "XYZ";
    for (int k = 0; k < 3; k++) {
      wcsutil_double2str(keyvalue, 96, format, wcs->obsgeo[k]);
      snprintf(comment, 128, "[m] observatory %c-coordinate", xyz[k]);
      obsgeo[7] = xyz[k];
      obsg[4]   = xyz[k];
      wcshdo_util(ctrl, obsgeo, obsg, 0, 0x0, 0, 0, 0, ' ', colnum, colax,
        keyvalue, comment, nkeyrec, header, &status);
    }

  } else if (
      !undefined(wcs->obsgeo[3]) &&
      !undefined(wcs->obsgeo[4]) &&
      !undefined(wcs->obsgeo[5])) {

    wcsutil_double2str(keyvalue, 96, format, wcs->obsgeo[3]);
    wcshdo_util(ctrl, "OBSGEO-L", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "[deg] IAU(1976) observatory longitude", nkeyrec, header,
      &status);

    wcsutil_double2str(keyvalue, 96, format, wcs->obsgeo[4]);
    wcshdo_util(ctrl, "OBSGEO-B", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "[deg] IAU(1976) observatory latitude", nkeyrec, header,
      &status);

    wcsutil_double2str(keyvalue, 96, format, wcs->obsgeo[5]);
    wcshdo_util(ctrl, "OBSGEO-L", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "[m]   IAU(1976) observatory height", nkeyrec, header,
      &status);
  }

  // Spacecraft orbit ephemeris file.
  if (wcs->obsorbit[0]) {
    snprintf(keyvalue, 96, "'%s'", wcs->obsorbit);
    wcshdo_util(ctrl, "OBSORBIT", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "Spacecraft orbit ephemeris file", nkeyrec, header, &status);
  }

  // Equatorial coordinate system type.
  if (wcs->radesys[0]) {
    snprintf(keyvalue, 96, "'%s'", wcs->radesys);
    wcshdo_util(ctrl, "RADESYS", "RADE", 0, 0x0, 0, 0, 0, alt, colnum, colax,
      keyvalue, "Equatorial coordinate system", nkeyrec, header, &status);
  }

  // Equinox of equatorial coordinate system.
  if (!undefined(wcs->equinox)) {
    wcsutil_double2str(keyvalue, 96, format, wcs->equinox);
    wcshdo_util(ctrl, "EQUINOX", "EQUI", 0, 0x0, 0, 0, 0, alt, colnum, colax,
      keyvalue, "[yr] Equinox of equatorial coordinates", nkeyrec, header,
      &status);
  }

  // Reference frame of spectral coordinates.
  if (wcs->specsys[0]) {
    snprintf(keyvalue, 96, "'%s'", wcs->specsys);
    wcshdo_util(ctrl, "SPECSYS", "SPEC", 0, 0x0, 0, 0, 0, alt, colnum, colax,
      keyvalue, "Reference frame of spectral coordinates", nkeyrec, header,
      &status);
  }

  // Reference frame of spectral observation.
  if (wcs->ssysobs[0]) {
    snprintf(keyvalue, 96, "'%s'", wcs->ssysobs);
    wcshdo_util(ctrl, "SSYSOBS", "SOBS", 0, 0x0, 0, 0, 0, alt, colnum, colax,
      keyvalue, "Reference frame of spectral observation", nkeyrec, header,
      &status);
  }

  // Observer's velocity towards source.
  if (!undefined(wcs->velosys)) {
    wcsutil_double2str(keyvalue, 96, format, wcs->velosys);
    wcshdo_util(ctrl, "VELOSYS", "VSYS", 0, 0x0, 0, 0, 0, alt, colnum, colax,
      keyvalue, "[m/s] Velocity towards source", nkeyrec, header, &status);
  }

  // Redshift of the source.
  if (!undefined(wcs->zsource)) {
    wcsutil_double2str(keyvalue, 96, format, wcs->zsource);
    wcshdo_util(ctrl, "ZSOURCE", "ZSOU", 0, 0x0, 0, 0, 0, alt, colnum, colax,
      keyvalue, "Redshift of the source", nkeyrec, header, &status);
  }

  // Reference frame of source redshift.
  if (wcs->ssyssrc[0]) {
    snprintf(keyvalue, 96, "'%s'", wcs->ssyssrc);
    wcshdo_util(ctrl, "SSYSSRC", "SSRC", 0, 0x0, 0, 0, 0, alt, colnum, colax,
      keyvalue, "Reference frame of source redshift", nkeyrec, header,
      &status);
  }

  // Velocity orientation angle.
  if (!undefined(wcs->velangl)) {
    wcsutil_double2str(keyvalue, 96, format, wcs->velangl);
    wcshdo_util(ctrl, "VELANGL", "VANG", 0, 0x0, 0, 0, 0, alt, colnum, colax,
      keyvalue, "[deg] Velocity orientation angle", nkeyrec, header, &status);
  }

  // - - - - - - - - - - - - - - - - - - - -  Additional auxiliary parameters.

  struct auxprm *aux;
  if ((aux = wcs->aux)) {
    if (!undefined(aux->rsun_ref)) {
      wcsutil_double2str(keyvalue, 96, format, aux->rsun_ref);
      wcshdo_util(ctrl, "RSUN_REF", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        keyvalue, "[m] Solar radius", nkeyrec, header, &status);
    }

    if (!undefined(aux->dsun_obs)) {
      wcsutil_double2str(keyvalue, 96, format, aux->dsun_obs);
      wcshdo_util(ctrl, "DSUN_OBS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        keyvalue, "[m] Distance from centre of Sun to observer", nkeyrec,
        header, &status);
    }

    if (!undefined(aux->crln_obs)) {
      wcsutil_double2str(keyvalue, 96, format, aux->crln_obs);
      wcshdo_util(ctrl, "CRLN_OBS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        keyvalue, "[deg] Carrington heliographic lng of observer", nkeyrec,
        header, &status);

      if (!undefined(aux->hglt_obs)) {
        wcsutil_double2str(keyvalue, 96, format, aux->hglt_obs);
        wcshdo_util(ctrl, "CRLT_OBS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
          keyvalue, "[deg] Heliographic latitude of observer", nkeyrec,
          header, &status);
      }
    }

    if (!undefined(aux->hgln_obs)) {
      wcsutil_double2str(keyvalue, 96, format, aux->hgln_obs);
      wcshdo_util(ctrl, "HGLN_OBS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        keyvalue, "[deg] Stonyhurst heliographic lng of observer", nkeyrec,
        header, &status);

      if (!undefined(aux->hglt_obs)) {
        wcsutil_double2str(keyvalue, 96, format, aux->hglt_obs);
        wcshdo_util(ctrl, "HGLT_OBS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
          keyvalue, "[deg] Heliographic latitude of observer", nkeyrec,
          header, &status);
      }
    }

    if (!undefined(aux->a_radius)) {
      wcsutil_double2str(keyvalue, 96, format, aux->a_radius);
      wcshdo_util(ctrl, "A_RADIUS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        keyvalue, "[m] Object ellipsoid semi-major axis", nkeyrec,
        header, &status);
    }

    if (!undefined(aux->b_radius)) {
      wcsutil_double2str(keyvalue, 96, format, aux->b_radius);
      wcshdo_util(ctrl, "B_RADIUS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        keyvalue, "[m] Object ellipsoid semi-intermediate axis", nkeyrec,
        header, &status);
    }

    if (!undefined(aux->c_radius)) {
      wcsutil_double2str(keyvalue, 96, format, aux->c_radius);
      wcshdo_util(ctrl, "C_RADIUS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        keyvalue, "[m] Object ellipsoid semi-minor axis", nkeyrec,
        header, &status);
    }

    if (!undefined(aux->blon_obs)) {
      wcsutil_double2str(keyvalue, 96, format, aux->blon_obs);
      wcshdo_util(ctrl, "BLON_OBS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        keyvalue, "[deg] Bodycentric longitude of observer", nkeyrec,
        header, &status);
    }

    if (!undefined(aux->blat_obs)) {
      wcsutil_double2str(keyvalue, 96, format, aux->blat_obs);
      wcshdo_util(ctrl, "BLAT_OBS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        keyvalue, "[deg] Bodycentric latitude of observer", nkeyrec,
        header, &status);
    }

    if (!undefined(aux->bdis_obs)) {
      wcsutil_double2str(keyvalue, 96, format, aux->bdis_obs);
      wcshdo_util(ctrl, "BDIS_OBS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        keyvalue, "[m] Bodycentric distance of observer", nkeyrec,
        header, &status);
    }
  }

  // - - - - - - - - - - - - - - - - - - - - - Distortion function parameters.

  char term[16];
  double *dparm, keyval;

  if (dosip) {
    // Simple Imaging Polynomial (SIP) is handled by translating its dpkey
    // records.  Determine a suitable numerical precision for the
    // polynomial coefficients to avoid trailing zeroes common to all of
    // them.
    dis = wcs->lin.dispre;
    if (dofmt) {
      struct dpkey *ikeyp = dis->dp;
      int kp0 = 2;
      for (int idp = 0; idp < dis->ndp; idp++, ikeyp++) {
        cp = strchr(ikeyp->field, '.') + 1;
        if (strncmp(cp, "SIP.", 4) != 0) continue;
        wcsutil_double2str(keyvalue, 96, "%20.13E", dpkeyd(ikeyp));

        int kpi = 15;
        while (kp0 < kpi && keyvalue[kpi] == '0') kpi--;
        kp0 = kpi;
      }

      int precision = kp0 - 2;
      if (precision < 1)  precision = 1;
      if (13 < precision) precision = 13;
      snprintf(format, 16, "%%20.%dE", precision);
    }

    // Ensure the coefficients are written in a human-readable sequence.
    for (int j = 0; j <= 1; j++) {
      // Distortion function polynomial coefficients.
      wcshdo_util(ctrl, "", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        "", "", nkeyrec, header, &status);

      if (j == 0) {
        strncpy(keyword, "A_", 16);
      } else {
        strncpy(keyword, "B_", 16);
      }

      int degree;
      int ncoeff = dis->iparm[j][I_TPDNCO];
      for (degree = 0; degree <= 9; degree++) {
        if (ncoeff <= nTPD[degree]) break;
      }

      strncpy(keyword+2, "ORDER", 14);
      snprintf(keyvalue, 96, "%20d", degree);
      snprintf(comment, 128, "SIP polynomial degree, axis %d, pixel-to-sky",
        j+1);
      wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        keyvalue, comment, nkeyrec, header, &status);

      struct dpkey *ikeyp = dis->dp;
      for (int idp = 0; idp < dis->ndp; idp++, ikeyp++) {
        if (ikeyp->j != j+1) continue;
        if ((keyval = dpkeyd(ikeyp)) == 0.0) continue;

        cp = strchr(ikeyp->field, '.') + 1;
        if (strncmp(cp, "SIP.FWD.", 8) != 0) continue;
        cp += 8;
        strncpy(keyword+2, cp, 14);
        int p, q;
        sscanf(cp, "%d_%d", &p, &q);
        strncpy(term, "xxxxxxxxx", p);
        strncpy(term+p, "yyyyyyyyy", q);
        term[p+q] = '\0';

        wcsutil_double2str(keyvalue, 96, format, keyval);
        snprintf(comment, 128, "SIP distortion coefficient: %s", term);
        wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
          keyvalue, comment, nkeyrec, header, &status);
      }

      if (dis->maxdis[j] != 0.0) {
        strncpy(keyword+2, "DMAX", 14);
        wcsutil_double2str(keyvalue, 96, "%20.3f", dis->maxdis[j]);
        wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
          keyvalue, "Maximum value of distortion function", nkeyrec,
          header, &status);
      }

      // Inverse distortion function polynomial coefficients.
      if (dis->disx2p == 0x0) continue;

      wcshdo_util(ctrl, "", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        "", "", nkeyrec, header, &status);

      if (j == 0) {
        strncpy(keyword, "AP_", 16);
      } else {
        strncpy(keyword, "BP_", 16);
      }

      ncoeff = dis->iparm[j][I_NDPARM] - dis->iparm[j][I_TPDNCO];
      for (degree = 0; degree <= 9; degree++) {
        if (ncoeff <= nTPD[degree]) break;
      }

      strncpy(keyword+3, "ORDER", 13);
      snprintf(keyvalue, 96, "%20d", degree);
      snprintf(comment, 128, "SIP polynomial degree, axis %d, sky-to-pixel",
        j+1);
      wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        keyvalue, comment, nkeyrec, header, &status);

      ikeyp = dis->dp;
      for (int idp = 0; idp < dis->ndp; idp++, ikeyp++) {
        if (ikeyp->j != j+1) continue;
        if ((keyval = dpkeyd(ikeyp)) == 0.0) continue;

        cp = strchr(ikeyp->field, '.') + 1;
        if (strncmp(cp, "SIP.REV.", 8) != 0) continue;
        cp += 8;
        strncpy(keyword+3, cp, 13);
        int p, q;
        sscanf(cp, "%d_%d", &p, &q);
        strncpy(term, "xxxxxxxxx", p);
        strncpy(term+p, "yyyyyyyyy", q);
        term[p+q] = '\0';

        wcsutil_double2str(keyvalue, 96, format, keyval);
        snprintf(comment, 128, "SIP inverse coefficient: %s", term);
        wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
          keyvalue, comment, nkeyrec, header, &status);
      }
    }
  }

  for (int idis = 0; idis < 2; idis++) {
    if (idis == 0 && (dis = wcs->lin.dispre) == 0x0) continue;
    if (idis == 1 && (dis = wcs->lin.disseq) == 0x0) continue;

    for (int j = 0; j < naxis; j++) {
      if (dis->disp2x[j] == 0x0) continue;

      int *iparm = dis->iparm[j];
      dparm = dis->dparm[j];

      // Identify the distortion type.
      if (dotpv) {
        // TPV "projection" is handled by translating its dpkey records,
        // which were originally translated from PVi_ma by wcsset(), or
        // possibly input directly as a CQDISia = 'TPV' distortion type.
        // Determine a suitable numerical precision for the polynomial
        // coefficients to avoid trailing zeroes common to all of them.
        if (dofmt) wcshdo_format('E', iparm[I_NDPARM], dparm, format);
        char fmt01[8];
        snprintf(fmt01, 8, "%.3ss", format);

        wcshdo_util(ctrl, "", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
          "", "", nkeyrec, header, &status);

        // Distortion function polynomial coefficients.
        snprintf(keyword, 16, "PV%d_", j+1);
        char *kw = keyword + strlen(keyword);

        struct dpkey *ikeyp = dis->dp;
        for (int idp = 0; idp < dis->ndp; idp++, ikeyp++) {
          if (ikeyp->j != j+1) continue;
          if ((keyval = dpkeyd(ikeyp)) == 0.0) continue;

          cp = strchr(ikeyp->field, '.') + 1;
          if (strncmp(cp, "TPV.", 4) != 0) continue;

          size_t ksize = kwe - kw;
          strncpy(kw, cp+4, ksize);

          // Identify the term of the TPV polynomial for human readers.
          int m;
          sscanf(cp+4, "%d", &m);
          wcshdo_tpdterm(m, j == wcs->lng, term);
          snprintf(comment, 128, "TPV coefficient: %s", term);

          if (keyval == 1.0) {
            snprintf(keyvalue, 96, fmt01, "1.0");
          } else {
            wcsutil_double2str(keyvalue, 96, format, keyval);
          }
          wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
            keyvalue, comment, nkeyrec, header, &status);
        }

      } else if (strcmp(dis->dtype[j], "TPD") == 0 || dotpd ||
                 strcmp(dis->dtype[j], "Polynomial")  == 0 ||
                 strcmp(dis->dtype[j], "Polynomial*") == 0) {
        // One of the Paper IV type polynomial distortions.
        wcshdo_util(ctrl, "", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
          "", "", nkeyrec, header, &status);

        if (strcmp(dis->dtype[j], "TPD") == 0) {
          // Pure TPD.
          dotpd = 1;
        } else if (strncmp(dis->dtype[j], "Polynomial", 10) == 0) {
          // Polynomial distortion.  Write it as TPD by request?
          dotpd = (iparm[I_DTYPE] & DIS_DOTPD);
          strncpy(tpdsrc, "Polynomial distortion", 24);
        }

        char pq = idis ? 'Q' : 'P';
        int Nhat = dis->Nhat[j];

        // CPDISja/CQDISia
        snprintf(keyword, 16, "C%cDIS%d", pq, j+1);
        if (idis == 0) {
          strncpy(comment, "P = prior, ", 128);
        } else {
          strncpy(comment, "Q = sequent, ", 128);
        }

        int direct = 0, doaux = 0;
        char *cm = comment + strlen(comment);
        size_t csize = cme - cm;
        if (dotpd) {
          strncpy(keyvalue, "'TPD'", 96);
          strncpy(cm, "Template Polynomial Distortion", csize);

          // For identifying terms of the TPD polynomial.
          int *axmap = dis->axmap[j];
          direct = 1;
          doaux  = iparm[I_TPDAUX];
          if (Nhat == 2) {
            // Associate x with longitude, y with latitude.
            if (axmap[0] == wcs->lng && axmap[1] == wcs->lat) {
              direct = 1;
            } else if (axmap[0] == wcs->lat && axmap[1] == wcs->lng) {
              direct = 0;
            } else {
              // Non-celestial.
              direct = (axmap[0] < axmap[1]);
            }
          }
        } else {
          strncpy(keyvalue, "'Polynomial'", 96);
          strncpy(cm, "general Polynomial distortion", csize);
        }

        wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
          keyvalue, comment, nkeyrec, header, &status);

        // NAXES.
        snprintf(keyword, 16,  "D%c%d", pq, j+1);
        snprintf(keyvalue, 96, "'NAXES:  %d'", Nhat);
        if (Nhat == 1) {
          strncpy(comment,  "One independent variable", 128);
        } else if (Nhat == 2) {
          strncpy(comment,  "Two independent variables", 128);
        } else {
          strncpy(comment,  "Number of independent variables", 128);
        }
        wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
          keyvalue, comment, nkeyrec, header, &status);

        // AXIS.jhat
        for (int jhat = 0; jhat < Nhat; jhat++) {
          int *axmap = dis->axmap[j];
          snprintf(keyvalue, 96, "'AXIS.%d: %d'", jhat+1, axmap[jhat]+1);
          if (jhat == 0) {
            strncpy(comment, "1st", 128);
          } else if (jhat == 1) {
            strncpy(comment, "2nd", 128);
          } else if (jhat == 2) {
            strncpy(comment, "3rd", 128);
          } else {
            snprintf(comment, 128, "%dth", jhat+1);
          }

          snprintf(comment, 128+strlen(comment),
            " independent variable: axis %d",
            axmap[jhat]+1);
          if (dotpd) {
            // axid is "xyxuvu".
            cp = axid;
            if (!direct) cp++;
            if (doaux) cp += 3;
            snprintf(comment, 128-strlen(comment), " (= %c)", cp[jhat]);
          }

          wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
            keyvalue, comment, nkeyrec, header, &status);
        }

        char ctemp[32];

        // OFFSET.jhat
        if (dofmt) wcshdo_format('f', Nhat, dis->offset[j], format);
        for (int jhat = 0; jhat < Nhat; jhat++) {
          if (dis->offset[j][jhat] == 0.0) continue;

          wcsutil_double2str(ctemp, 32, format, dis->offset[j][jhat]);
          snprintf(keyvalue, 96, "'OFFSET.%d: %s'", jhat+1, ctemp);
          snprintf(comment, 128, "Variable %d renormalization offset",
            jhat+1);

          wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
            keyvalue, comment, nkeyrec, header, &status);
        }

        // SCALE.jhat
        if (dofmt) wcshdo_format('f', Nhat, dis->scale[j], format);
        for (int jhat = 0; jhat < Nhat; jhat++) {
          if (dis->scale[j][jhat] == 1.0) continue;

          wcsutil_double2str(ctemp, 32, format, dis->scale[j][jhat]);
          snprintf(keyvalue, 96, "'SCALE.%d: %s'", jhat+1, ctemp);
          snprintf(comment, 128, "Variable %d renormalization scale", jhat+1);

          wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
            keyvalue, comment, nkeyrec, header, &status);
        }

        // Does the distortion function compute a correction?
        if (dis->docorr[j]) {
          wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
            "'DOCORR: 1'", "Distortion function computes a correction",
            nkeyrec, header, &status);
        } else {
          wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
            "'DOCORR: 0'", "Distortion function computes coordinates",
            nkeyrec, header, &status);
        }

        if (dotpd) {
          // Template Polynomial Distortion (TPD).  As it may have been
          // translated from SIP, TPV, DSS, TNX, ZPX, or perhaps
          // Polynomial, the dpkey records may not relate to TPD.
          // Output is therefore handled via dparm.
          if (dofmt) wcshdo_format('E', iparm[I_NDPARM], dparm, format);
          char fmt01[8];
          snprintf(fmt01, 8, "%.3ss", format);

          // AUX.jhat.COEFF.m
          if (doaux) {
            for (int idp = 0; idp < 6; idp++) {
              if (dparm[idp] == 0.0) {
                snprintf(ctemp, 32, fmt01, "0.0");
              } else if (dparm[idp] == 1.0) {
                snprintf(ctemp, 32, fmt01, "1.0");
              } else {
                wcsutil_double2str(ctemp, 32, format, dparm[idp]);
              }

              if (idp < 3) {
                snprintf(keyvalue, 96, "'AUX.1.COEFF.%d: %s'", idp%3, ctemp);
                snprintf(comment, 128, "TPD: x = c0 + c1*u + c2*v");
              } else {
                snprintf(keyvalue, 96, "'AUX.2.COEFF.%d: %s'", idp%3, ctemp);
                snprintf(comment, 128, "TPD: y = d0 + d1*u + d2*v");
              }

              wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
                keyvalue, comment, nkeyrec, header, &status);

            }

            dparm += 6;
          }

          // TPD.FWD.m
          for (int idp = 0; idp < iparm[I_TPDNCO]; idp++) {
            if (dparm[idp] == 0.0) continue;

            if (dparm[idp] == 1.0) {
              snprintf(ctemp, 32, fmt01, "1.0");
            } else {
              wcsutil_double2str(ctemp, 32, format, dparm[idp]);
            }

            int m = idp;
            snprintf(keyvalue, 96, "'TPD.FWD.%d:%s %s'", m, (m<10)?" ":"",
              ctemp);
            wcshdo_tpdterm(m, direct, term);
            snprintf(comment, 128, "TPD coefficient: %s", term);

            wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
              keyvalue, comment, nkeyrec, header, &status);
          }

          // CPERRja/CQERRia
          if (dis->maxdis[j] != 0.0) {
            snprintf(keyword, 16,  "C%cERR%d", pq, j+1);
            snprintf(keyvalue, 96, "%20.2f", dis->maxdis[j]);
            snprintf(comment, 128, "%sMaximum absolute value of distortion",
              idis?"":"[pix] ");
            wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
              keyvalue, comment, nkeyrec, header, &status);
          }

          // Inverse distortion function polynomial coefficients.
          if (dis->disx2p[j] == 0x0) continue;

          wcshdo_util(ctrl, "", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
            "", "", nkeyrec, header, &status);

          // TPD.REV.m
          snprintf(keyword, 16,  "D%c%d", pq, j+1);
          for (int idp = iparm[I_TPDNCO]; idp < iparm[I_NDPARM]; idp++) {
            if (dparm[idp] == 0.0) continue;

            wcsutil_double2str(ctemp, 32, format, dparm[idp]);
            int m = idp - iparm[I_TPDNCO];
            snprintf(keyvalue, 96, "'TPD.REV.%d:%s %s'", m, (m<10)?" ":"",
              ctemp);
            wcshdo_tpdterm(m, direct, term);
            snprintf(comment, 128, "TPD coefficient: %s", term);

            wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
              keyvalue, comment, nkeyrec, header, &status);
          }

        } else {
          // General polynomial distortion, handled via its dpkey records
          // since iparm and dparm may hold a translation to TPD.

          // Do auxiliary variables first.
          struct dpkey *ikeyp = dis->dp;
          for (int idp = 0; idp < dis->ndp; idp++, ikeyp++) {
            if (ikeyp->j != j+1) continue;

            cp = strchr(ikeyp->field, '.') + 1;
            if (strncmp(cp, "NAUX", 4) != 0) continue;

            snprintf(keyvalue, 96, "'%s: %d'", cp, dpkeyi(ikeyp));
            wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
              keyvalue, "Number of auxiliary variables", nkeyrec, header,
              &status);

            struct dpkey *jkeyp = dis->dp;
            for (int jdp = 0; jdp < dis->ndp; jdp++, jkeyp++) {
              if (jkeyp->j != j+1) continue;

              keyval = dpkeyd(jkeyp);

              cp = strchr(jkeyp->field, '.') + 1;
              if (strncmp(cp, "AUX.", 4) != 0) continue;

              int m;
              sscanf(cp+4, "%d", &m);
              snprintf(keyvalue, 96, "'%s:", cp);

              cp = strchr(cp+4, '.') + 1;

              char *kv = keyvalue + strlen(keyvalue);
              size_t ksize = kve - kv;
              if ((double)((int)keyval) == keyval) {
                snprintf(kv, ksize, "%4d'", (int)keyval);
              } else if (keyval == 0.5) {
                strncpy(kv, " 0.5'", ksize);
              } else {
                wcsutil_double2str(kv, ksize, "%21.13E", keyval);
                kv += strlen(kv);
                ksize = kve - kv;
                strncpy(kv, "'", ksize);
              }

              int p;
              sscanf(cp+6, "%d", &p);
              if (strncmp(cp, "POWER.", 4) == 0) {
                if (p) {
                  snprintf(comment, 128, "Aux %d: var %d power", m, p);
                } else {
                  snprintf(comment, 128, "Aux %d: power of sum of terms", m);
                }
              } else {
                if (p) {
                  snprintf(comment, 128, "Aux %d: var %d coefficient", m, p);
                } else {
                  snprintf(comment, 128, "Aux %d: offset term", m);
                }
              }

              wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
                keyvalue, comment, nkeyrec, header, &status);
            }

            break;
          }

          // Do polynomial terms.
          ikeyp = dis->dp;
          for (int idp = 0; idp < dis->ndp; idp++, ikeyp++) {
            if (ikeyp->j != j+1) continue;

            cp = strchr(ikeyp->field, '.') + 1;
            if (strncmp(cp, "NTERMS", 6) != 0) continue;

            snprintf(keyvalue, 96, "'%s: %d'", cp, dpkeyi(ikeyp));
            wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
              keyvalue, "Number of terms in the polynomial", nkeyrec, header,
              &status);
          }

          ikeyp = dis->dp;
          for (int idp = 0; idp < dis->ndp; idp++, ikeyp++) {
            if (ikeyp->j != j+1) continue;

            if ((keyval = dpkeyd(ikeyp)) == 0.0) continue;

            cp = strchr(ikeyp->field, '.') + 1;
            if (strncmp(cp, "TERM.", 5) != 0) continue;

            int m;
            sscanf(cp+5, "%d", &m);
            snprintf(keyvalue, 96, "'%s:%s ", cp, (m<10)?" ":"");

            cp = strchr(cp+5, '.') + 1;
            char *kv = keyvalue + strlen(keyvalue);
            size_t ksize = kve - kv;
            if (strncmp(cp, "VAR.", 4) == 0) {
              if ((double)((int)keyval) == keyval) {
                snprintf(kv, ksize, "%20d", (int)keyval);
              } else {
                wcsutil_double2str(kv, ksize, "%20.13f", keyval);
              }

              int p;
              sscanf(cp+4, "%d", &p);
              if (p <= Nhat) {
                snprintf(comment, 128, "Poly term %d: var %d power", m, p);
              } else {
                snprintf(comment, 128, "Poly term %d: aux %d power", m,
                  p-Nhat);
              }

            } else {
              wcsutil_double2str(kv, ksize, "%20.13E", keyval);
              snprintf(comment, 128, "Poly term %d: coefficient", m);
            }

            kv += strlen(kv);
            ksize = kve - kv;
            strncpy(kv, "'", ksize);

            wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
              keyvalue, comment, nkeyrec, header, &status);
          }

          // CPERRja/CQERRia
          if (dis->maxdis[j] != 0.0) {
            snprintf(keyword, 16,  "C%cERR%d", pq, j+1);
            snprintf(keyvalue, 96, "%20.2f", dis->maxdis[j]);
            snprintf(comment, 128, "%sMaximum absolute value of distortion",
              idis?"":"[pix] ");
            wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
              keyvalue, comment, nkeyrec, header, &status);
          }
        }
      }
    }

    // DVERRa
    if (dis->totdis != 0.0) {
      snprintf(keyvalue, 96, "%20.2f", dis->totdis);
      snprintf(comment, 128, "Maximum combined distortion");
      wcshdo_util(ctrl, "DVERR", 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
        keyvalue, comment, nkeyrec, header, &status);
    }
  }


  // Add identification.
  wcshdo_util(ctrl, "", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
    "", "", nkeyrec, header, &status);

  if (dotpd == DIS_DOTPD) {
    // TPD by translation.
    snprintf(comment, 128, "Translated from %s to TPD by WCSLIB %s", tpdsrc,
      wcslib_version(0x0));
  } else {
    snprintf(comment, 128, "WCS header keyrecords produced by WCSLIB %s",
      wcslib_version(0x0));
  }

  wcshdo_util(ctrl, "COMMENT", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
    "", comment, nkeyrec, header, &status);


  if (status == WCSHDRERR_MEMORY) {
    wcserr_set(WCSHDR_ERRMSG(status));
  }
  return status;
}

//----------------------------------------------------------------------------
// Determine a suitable floating point format for a set of parameters.

static void wcshdo_format(
  int fmt,
  int nval,
  const double val[],
  char format[16])

{
  int emax = -999;
  int emin = +999;
  int precision = 0;
  for (int i = 0; i < nval; i++) {
    // Double precision has at least 15 significant digits, and up to 17:
    // http://en.wikipedia.org/wiki/Double-precision_floating-point_format
    char cval[24];
    wcsutil_double2str(cval, 24, "%21.14E", val[i]);

    int cpi = 16;
    while (2 < cpi && cval[cpi] == '0') cpi--;

    // Precision for 'E' format.
    cpi -= 2;
    if (precision < cpi) precision = cpi;

    // Range of significant digits for 'f' format.
    int expon;
    sscanf(cval+18, "%d", &expon);

    if (emax < expon) emax = expon;
    expon -= cpi;
    if (expon < emin) emin = expon;
  }


  if (fmt == 'G') {
    // Because e.g. writing 1e4 as 10000 requires an extra digit.
    emax++;

    if (emin < -15 || 15 < emax || 15 < (emax - emin)) {
      fmt = 'E';
    } else {
      fmt = 'f';
    }
  }

  if (fmt == 'f') {
    precision = -emin;
    if (precision < 1)  precision = 1;
    if (17 < precision) precision = 17;
    snprintf(format, 16, "%%20.%df", precision);

  } else {
    if (precision < 1)  precision = 1;
    if (14 < precision) precision = 14;
    if (precision < 14) {
      snprintf(format, 16, "%%20.%dE", precision);
    } else {
      snprintf(format, 16, "%%21.%dE", precision);
    }
  }
}

//----------------------------------------------------------------------------
// Construct a string that identifies the term of a TPD or TPV polynomial.

static void wcshdo_tpdterm(
  int m,
  int direct,
  char term[16])

{
  const int nTPD[] = {1, 4, 7, 12, 17, 24, 31, 40, 49, 60};

  int degree;
  for (degree = 0; degree <= 9; degree++) {
    if (m < nTPD[degree]) break;
  }

  if (degree == 0) {
    strncpy(term, "1", 16);

  } else {
    int k = degree - (m - nTPD[degree-1]);

    if (k < 0) {
      memcpy(term, "rrrrrrrrr", degree);
    } else if (direct) {
      memcpy(term, "xxxxxxxxx", k);
      memcpy(term+k, "yyyyyyyyy", degree-k);
    } else {
      memcpy(term, "yyyyyyyyy", k);
      memcpy(term+k, "xxxxxxxxx", degree-k);
    }

    term[degree] = '\0';
  }
}

//----------------------------------------------------------------------------
// Construct a keyrecord from the components given.

static void wcshdo_util(
  int relax,
  const char pikey[],
  const char tbkey[],
  int level,
  const char tlkey[],
  int i,
  int j,
  int m,
  char alt,
  int  btcol,
  int  plcol[],
  char keyvalue[],
  const char keycomment[],
  int  *nkeyrec,
  char **header,
  int  *status)

{
  if (*status) return;

  // Reallocate memory in blocks of 2880 bytes.
  char *hptr;
  if ((*nkeyrec)%32 == 0) {
    int nbyte = ((*nkeyrec)/32 + 1) * 2880 + 1;
    if (!(hptr = realloc(*header, nbyte))) {
      *status = WCSHDRERR_MEMORY;
      return;
    }

    *header = hptr;
  }

  // Construct the keyword.
  char keyword[32];
  if (alt == ' ') alt = '\0';
  if (btcol) {
    // Binary table image array.
    if (i > 0 && j) {
      if (j > 0) {
        snprintf(keyword, 32, "%d%d%s%d%c", i, j, tbkey, btcol, alt);
      } else {
        snprintf(keyword, 32, "%d%s%d_%d%c", i, tbkey, btcol, m, alt);
      }
    } else if (i > 0) {
      snprintf(keyword, 32, "%d%s%d%c", i, tbkey, btcol, alt);
    } else if (j > 0) {
      snprintf(keyword, 32, "%d%s%d%c", j, tbkey, btcol, alt);
    } else {
      snprintf(keyword, 32, "%s%d%c", tbkey, btcol, alt);
    }

    if ((strlen(keyword) < 8) && tlkey && (relax & level)) {
      // Use the long form.
      if (i > 0 && j) {
        if (j > 0) {
          snprintf(keyword, 32, "%d%d%s%d%c", i, j, tlkey, btcol, alt);
        } else {
          snprintf(keyword, 32, "%d%s%d_%d%c", i, tlkey, btcol, m, alt);
        }
      } else if (i > 0) {
        snprintf(keyword, 32, "%d%s%d%c", i, tlkey, btcol, alt);
      } else if (j > 0) {
        snprintf(keyword, 32, "%d%s%d%c", j, tlkey, btcol, alt);
      } else {
        snprintf(keyword, 32, "%s%d%c", tlkey, btcol, alt);
      }
    }

  } else if (plcol && plcol[0]) {
    // Pixel list.
    if (i > 0 && j) {
      if (j > 0) {
        snprintf(keyword, 32, "T%s%d_%d%c", tbkey, plcol[i-1], plcol[j-1],
          alt);
      } else {
        snprintf(keyword, 32, "T%s%d_%d%c", tbkey, plcol[i-1], m, alt);
      }
    } else if (i > 0) {
      snprintf(keyword, 32, "T%s%d%c", tbkey, plcol[i-1], alt);
    } else if (j > 0) {
      snprintf(keyword, 32, "T%s%d%c", tbkey, plcol[j-1], alt);
    } else {
      snprintf(keyword, 32, "%s%d%c", tbkey, plcol[0], alt);
    }

    if ((strlen(keyword) < 8) && tlkey && (relax & level)) {
      // Use the long form.
      if (i > 0 && j) {
        if (j > 0) {
          snprintf(keyword, 32, "T%s%d_%d%c", tlkey, plcol[i-1], plcol[j-1],
            alt);
        } else {
          snprintf(keyword, 32, "T%s%d_%d%c", tlkey, plcol[i-1], m, alt);
        }
      } else if (i > 0) {
        snprintf(keyword, 32, "T%s%d%c", tlkey, plcol[i-1], alt);
      } else if (j > 0) {
        snprintf(keyword, 32, "T%s%d%c", tlkey, plcol[j-1], alt);
      } else {
        snprintf(keyword, 32, "%s%d%c", tlkey, plcol[0], alt);
      }
    }
  } else {
    if (i > 0 && j) {
      if (j > 0) {
        snprintf(keyword, 32, "%s%d_%d%c", pikey, i, j, alt);
      } else {
        snprintf(keyword, 32, "%s%d_%d%c", pikey, i, m, alt);
      }
    } else if (i > 0) {
      snprintf(keyword, 32, "%s%d%c", pikey, i, alt);
    } else if (j > 0) {
      snprintf(keyword, 32, "%s%d%c", pikey, j, alt);
    } else {
      snprintf(keyword, 32, "%s%c", pikey, alt);
    }
  }

  // Double-up single-quotes in string keyvalues.
  if (*keyvalue == '\'') {
    hptr = keyvalue + 1;
    while (*hptr) {
      if (*hptr == '\'') {
        char *kptr = hptr++;
        if (*hptr) {
          char ch0 = *kptr;
          while (*kptr) {
            char ch1 = *(++kptr);
            *kptr = ch0;
            ch0 = ch1;
          }
        } else {
          break;
        }
      }

      hptr++;
    }

    // Check length.
    if (strlen(keyvalue) > 70) {
      // Truncate.
      keyvalue[69] = '\'';
      keyvalue[70] = '\0';
    }

  } else {
    // Check length.
    if (strlen(keyvalue) > 70) {
      // Truncate.
      keyvalue[70] = '\0';
    }
  }

  int nc = 47, nv;
  if ((nv = (int)strlen(keyvalue)) > 20) {
    // Rob the keycomment to make space for the keyvalue.
    nc -= (nv - 20);
  }

  hptr = *header + (ptrdiff_t)(80*((*nkeyrec)++));
  if (*keyword == '\0') {
    snprintf(hptr, 81, "%80.80s", " ");
  } else if (strcmp(keyword, "COMMENT") == 0) {
    snprintf(hptr, 81, "%-8.8s %-71.71s", keyword, keycomment);
  } else {
    snprintf(hptr, 81, "%-8.8s= %-20s / %-*.*s", keyword, keyvalue, nc, nc,
      keycomment);
  }
}
@


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: wcshdr.c,v 8.5.1.2 2026/03/29 13:36:16 mcalabre Exp mcalabre $
d28 1
d65 2
a66 2
static void wcshdo_format(int, int, const double [], char *);
static void wcshdo_tpdterm(int, int, char *);
d162 1
a162 1
        strcpy(PSi_0a[itabax], wcs->ps[ip].value);
d167 1
a167 1
        strcpy(PSi_1a[itabax], wcs->ps[ip].value);
d172 1
a172 1
        strcpy(PSi_2a[itabax], wcs->ps[ip].value);
d175 3
d198 3
d321 1
a321 1
        strcpy(wtbp->extnam, PSi_0a[itabax]);
d324 1
a324 1
        strcpy(wtbp->ttype, PSi_1a[itabax]);
d344 1
a344 1
        strcpy(wtbp->extnam, PSi_0a[itabax]);
d347 1
a347 1
        strcpy(wtbp->ttype, PSi_2a[itabax]);
d414 3
a416 1
  for (short *ip = alts[0]; ip < alts[0] + 28*1000; ip++) {
d429 1
a429 1
  for (int iwcs = 0; iwcs < nwcs; iwcs++, wcsp++) {
d441 1
a441 1
          alts[wcsp->colax[i]][a]  = iwcs;
d445 1
a445 1
        alts[0][a]  = iwcs;
d455 1
a455 1
        alts[0][a]  = iwcs;
a507 3
  char comment[128], keyvalue[96], keyword[16];
  int  status = 0;

d514 1
d547 1
a547 1
    strcpy(format, "% 20.17G");
d549 1
a549 1
    strcpy(format, "% 20.16G");
d551 1
a551 1
    strcpy(format, "% 20.15G");
d553 1
a553 1
    strcpy(format, "% 20.14G");
d555 1
a555 1
    strcpy(format, "% 20.13G");
d557 1
a557 1
    strcpy(format, "%20.12G");
d570 4
d577 1
a577 1
    sprintf(keyvalue, "%20d", naxis);
d585 1
a585 1
    wcsutil_double2str(keyvalue, format, wcs->crpix[j]);
d602 1
a602 1
      wcsutil_double2str(keyvalue, format, wcs->pc[k]);
d613 1
a613 1
    wcsutil_double2str(keyvalue, format, wcs->cdelt[i]);
d615 4
a618 2
    if (wcs->cunit[i][0]) sprintf(comment, "[%s] ", wcs->cunit[i]);
    strcat(comment, "Coordinate increment at reference point");
d627 1
a627 1
    sprintf(keyvalue, "'%s'", wcs->cunit[i]);
d647 1
a647 1
        if (!dotpd) {;
d666 4
a669 2
          } else if (strncmp(wcs->ctype[0], "RA---TAN", 8) ||
                     strncmp(wcs->ctype[1], "DEC--TAN", 8)) {
d676 1
a676 1
            strcpy(tpdsrc, "SIP coordinates");
d713 1
a713 1
            strcpy(tpdsrc, "TPV \"projection\"");
d724 1
a724 1
        strcpy(tpdsrc, dis->dtype[i]);
d729 1
a729 1
        strcpy(tpdsrc, dis->dtype[i]+4);
d732 1
a732 1
          strcpy(tpdsrc, wcs->wcsname);
d734 3
a736 1
          strcat(tpdsrc, " \"projection\"");
d748 2
a749 2
    sprintf(keyvalue, "'%s'", wcs->ctype[i]);
    strcpy(comment, "Coordinate type code");
d756 1
a756 1
        strcpy(ctypei+8, "-SIP'");
d759 1
a759 1
        strcpy(ctypei+4, "-TPV'");
d763 1
a763 1
        strcpy(comment, "TAN (gnomonic) projection + SIP distortions");
d766 1
a766 1
        strcpy(comment, "TAN (gnomonic) projection + distortions");
d770 1
a770 1
          strcpy(comment, "Right ascension, ");
d773 1
a773 1
          strcpy(comment, "Declination, ");
d777 1
a777 1
          ctypei[0] = toupper(ctypei[0]);
d781 1
a781 1
            strcpy(comment, "Galactic l");
d784 1
a784 1
            strcpy(comment, "Ecliptic l");
d787 1
a787 1
            strcpy(comment, "Helioecliptic l");
d790 1
a790 1
            strcpy(comment, "Supergalactic l");
d794 1
a794 1
            strcpy(comment, "L");
d798 2
d801 1
a801 1
            strcat(comment, "ongitude, ");
d803 1
a803 1
            strcat(comment, "atitude, ");
d807 7
a813 2
        strcat(comment, wcs->cel.prj.name);
        strcat(comment, " projection");
d819 4
d824 1
a824 1
        strcat(comment, " (linear)");
d828 1
a828 1
          strcat(comment, " (linear in frequency)");
d831 1
a831 1
          strcat(comment, " (linear in velocity)");
d834 4
a837 1
          strcat(comment, " (linear in wavelength)");
d850 1
a850 1
    wcsutil_double2str(keyvalue, format, wcs->crval[i]);
d852 4
a855 2
    if (wcs->cunit[i][0]) sprintf(comment, "[%s] ", wcs->cunit[i]);
    strcat(comment, "Coordinate value at reference point");
d861 1
a861 1
  if (dofmt) strcpy(format, "%20.12G");
d863 1
a863 1
    wcsutil_double2str(keyvalue, format, (wcs->pv[k]).value);
d867 2
a868 1
        strcpy(comment, "[deg] Native longitude of the reference point");
d871 2
a872 1
        strcpy(comment, "[deg] Native latitude  of the reference point");
d876 1
a876 1
          sprintf(keyword, "LONPOLE%c", alt);
d878 1
a878 1
          sprintf(keyword, "LONP%d%c", colnum, alt);
d880 1
a880 1
          sprintf(keyword, "LONP%d%c", colax[(wcs->pv[k]).i - 1], alt);
d882 2
a883 1
        sprintf(comment, "[deg] alias for %s (has precedence)", keyword);
d887 1
a887 1
          sprintf(keyword, "LATPOLE%c", alt);
d889 1
a889 1
          sprintf(keyword, "LATP%d%c", colnum, alt);
d891 1
a891 1
          sprintf(keyword, "LATP%d%c", colax[(wcs->pv[k]).i - 1], alt);
d893 7
a899 1
        sprintf(comment, "[deg] alias for %s (has precedence)", keyword);
d903 1
a903 1
      sprintf(comment, "%s projection parameter", wcs->cel.prj.code);
d905 1
a905 1
      strcpy(comment, "Coordinate transformation parameter");
d914 1
a914 1
    sprintf(keyvalue, "'%s'", (wcs->ps[k]).value);
d922 1
a922 1
    wcsutil_double2str(keyvalue, format, wcs->lonpole);
d929 1
a929 1
    wcsutil_double2str(keyvalue, format, wcs->latpole);
d936 1
a936 1
    wcsutil_double2str(keyvalue, format, wcs->restfrq);
d942 1
a942 1
    wcsutil_double2str(keyvalue, format, wcs->restwav);
d949 1
a949 1
  sprintf(timeunit, "%.15s", wcs->timeunit[0] ? wcs->timeunit : "s");
d956 1
a956 1
      sprintf(keyvalue, "'%s'", wcs->cname[i]);
d968 1
a968 1
      wcsutil_double2str(keyvalue, format, wcs->crder[i]);
d970 4
a973 2
      if (wcs->cunit[i][0]) sprintf(comment, "[%s] ", wcs->cunit[i]);
      strcat(comment, "Random error in coordinate");
d984 1
a984 1
      wcsutil_double2str(keyvalue, format, wcs->csyer[i]);
d986 4
a989 2
      if (wcs->cunit[i][0]) sprintf(comment, "[%s] ", wcs->cunit[i]);
      strcat(comment, "Systematic error in coordinate");
d1000 3
a1002 2
      wcsutil_double2str(keyvalue, format, wcs->czphs[i]);
      sprintf(comment, "[%s] Time at zero point of phase axis", timeunit);
d1013 2
a1014 2
      wcsutil_double2str(keyvalue, format, wcs->cperi[i]);
      sprintf(comment, "[%s] Period of phase axis", timeunit);
d1024 1
a1024 1
    sprintf(keyvalue, "'%s'", wcs->wcsname);
d1040 1
a1040 1
    sprintf(keyvalue, "'%s'", wcs->timesys);
d1047 1
a1047 1
    sprintf(keyvalue, "'%s'", wcs->trefpos);
d1054 1
a1054 1
    sprintf(keyvalue, "'%s'", wcs->trefdir);
d1061 1
a1061 1
    sprintf(keyvalue, "'%s'", wcs->plephem);
d1069 1
a1069 1
    sprintf(keyvalue, "'%s'", wcs->timeunit);
d1077 1
a1077 1
    wcsutil_double2str(keyvalue, format, 0.0);
d1084 1
a1084 1
      sprintf(keyvalue, "'%s'", wcs->dateref);
d1092 1
a1092 1
        wcsutil_double2str(keyvalue, format, wcs->mjdref[0]);
d1100 1
a1100 1
        wcsutil_double2str(keyvalue, format, wcs->mjdref[0]);
d1108 1
a1108 1
        wcsutil_double2str(keyvalue, format, wcs->mjdref[1]);
d1118 2
a1119 2
    wcsutil_double2str(keyvalue, format, wcs->timeoffs);
    sprintf(comment, "[%s] Clock correction", timeunit);
d1128 2
a1129 2
    sprintf(keyvalue, "'%s'", wcs->dateobs);
    strcpy(comment, "ISO-8601 time of observation");
d1144 1
a1144 1
    wcsutil_double2str(keyvalue, format, wcs->mjdobs);
d1151 1
a1151 1
    wcsutil_double2str(keyvalue, format, wcs->jepoch);
d1158 1
a1158 1
    wcsutil_double2str(keyvalue, format, wcs->bepoch);
d1166 1
a1166 1
    sprintf(keyvalue, "'%s'", wcs->datebeg);
d1174 1
a1174 1
    wcsutil_double2str(keyvalue, format, wcs->mjdbeg);
d1181 2
a1182 2
    wcsutil_double2str(keyvalue, format, wcs->tstart);
    sprintf(comment, "[%s] Time elapsed since fiducial time at start",
d1190 1
a1190 1
    sprintf(keyvalue, "'%s'", wcs->dateavg);
d1198 1
a1198 1
    wcsutil_double2str(keyvalue, format, wcs->mjdavg);
d1206 1
a1206 1
    sprintf(keyvalue, "'%s'", wcs->dateend);
d1214 1
a1214 1
    wcsutil_double2str(keyvalue, format, wcs->mjdend);
d1221 2
a1222 2
    wcsutil_double2str(keyvalue, format, wcs->tstop);
    sprintf(comment, "[%s] Time elapsed since fiducial time at end",
d1230 2
a1231 2
    wcsutil_double2str(keyvalue, format, wcs->xposure);
    sprintf(comment, "[%s] Exposure (integration) time", timeunit);
d1238 2
a1239 2
    wcsutil_double2str(keyvalue, format, wcs->telapse);
    sprintf(comment, "[%s] Elapsed time (start to stop)", timeunit);
d1248 3
a1250 2
    wcsutil_double2str(keyvalue, format, wcs->timsyer);
    sprintf(comment, "[%s] Systematic error in time measurements", timeunit);
d1257 3
a1259 2
    wcsutil_double2str(keyvalue, format, wcs->timrder);
    sprintf(comment, "[%s] Relative error in time measurements", timeunit);
d1266 2
a1267 2
    wcsutil_double2str(keyvalue, format, wcs->timedel);
    sprintf(comment, "[%s] Time resolution", timeunit);
d1274 1
a1274 1
    wcsutil_double2str(keyvalue, format, wcs->timepixr);
d1289 2
a1290 2
      wcsutil_double2str(keyvalue, format, wcs->obsgeo[k]);
      sprintf(comment, "[m] observatory %c-coordinate", xyz[k]);
d1302 1
a1302 1
    wcsutil_double2str(keyvalue, format, wcs->obsgeo[3]);
d1307 1
a1307 1
    wcsutil_double2str(keyvalue, format, wcs->obsgeo[4]);
d1312 1
a1312 1
    wcsutil_double2str(keyvalue, format, wcs->obsgeo[5]);
d1320 1
a1320 1
    sprintf(keyvalue, "'%s'", wcs->obsorbit);
d1327 1
a1327 1
    sprintf(keyvalue, "'%s'", wcs->radesys);
d1334 1
a1334 1
    wcsutil_double2str(keyvalue, format, wcs->equinox);
d1342 1
a1342 1
    sprintf(keyvalue, "'%s'", wcs->specsys);
d1350 1
a1350 1
    sprintf(keyvalue, "'%s'", wcs->ssysobs);
d1358 1
a1358 1
    wcsutil_double2str(keyvalue, format, wcs->velosys);
d1365 1
a1365 1
    wcsutil_double2str(keyvalue, format, wcs->zsource);
d1372 1
a1372 1
    sprintf(keyvalue, "'%s'", wcs->ssyssrc);
d1380 1
a1380 1
    wcsutil_double2str(keyvalue, format, wcs->velangl);
d1390 1
a1390 1
      wcsutil_double2str(keyvalue, format, aux->rsun_ref);
d1396 1
a1396 1
      wcsutil_double2str(keyvalue, format, aux->dsun_obs);
d1403 1
a1403 1
      wcsutil_double2str(keyvalue, format, aux->crln_obs);
d1409 1
a1409 1
        wcsutil_double2str(keyvalue, format, aux->hglt_obs);
d1417 1
a1417 1
      wcsutil_double2str(keyvalue, format, aux->hgln_obs);
d1423 1
a1423 1
        wcsutil_double2str(keyvalue, format, aux->hglt_obs);
d1431 1
a1431 1
      wcsutil_double2str(keyvalue, format, aux->a_radius);
d1438 1
a1438 1
      wcsutil_double2str(keyvalue, format, aux->b_radius);
d1445 1
a1445 1
      wcsutil_double2str(keyvalue, format, aux->c_radius);
d1452 1
a1452 1
      wcsutil_double2str(keyvalue, format, aux->blon_obs);
d1459 1
a1459 1
      wcsutil_double2str(keyvalue, format, aux->blat_obs);
d1466 1
a1466 1
      wcsutil_double2str(keyvalue, format, aux->bdis_obs);
d1490 1
a1490 1
        wcsutil_double2str(keyvalue, "%20.13E", dpkeyd(ikeyp));
d1500 1
a1500 1
      sprintf(format, "%%20.%dE", precision);
d1510 1
a1510 1
        strcpy(keyword, "A_");
d1512 1
a1512 1
        strcpy(keyword, "B_");
d1521 4
a1524 3
      strcpy(keyword+2, "ORDER");
      sprintf(keyvalue, "%20d", degree);
      sprintf(comment, "SIP polynomial degree, axis %d, pixel-to-sky", j+1);
d1536 1
a1536 1
        strcpy(keyword+2, cp);
d1543 2
a1544 2
        wcsutil_double2str(keyvalue, format, keyval);
        sprintf(comment, "SIP distortion coefficient: %s", term);
d1550 2
a1551 2
        strcpy(keyword+2, "DMAX");
        wcsutil_double2str(keyvalue, "%20.3f", dis->maxdis[j]);
d1564 1
a1564 1
        strcpy(keyword, "AP_");
d1566 1
a1566 1
        strcpy(keyword, "BP_");
d1574 4
a1577 3
      strcpy(keyword+3, "ORDER");
      sprintf(keyvalue, "%20d", degree);
      sprintf(comment, "SIP polynomial degree, axis %d, sky-to-pixel", j+1);
d1589 1
a1589 1
        strcpy(keyword+3, cp);
d1596 2
a1597 2
        wcsutil_double2str(keyvalue, format, keyval);
        sprintf(comment, "SIP inverse coefficient: %s", term);
d1623 1
a1623 1
        sprintf(fmt01, "%.3ss", format);
d1629 2
a1630 2
        sprintf(keyword, "PV%d_", j+1);
        char *kp = keyword + strlen(keyword);
d1639 3
a1641 1
          strcpy(kp, cp+4);
d1647 1
a1647 1
          sprintf(comment, "TPV coefficient: %s", term);
d1650 1
a1650 1
            sprintf(keyvalue, fmt01, "1.0");
d1652 1
a1652 1
            wcsutil_double2str(keyvalue, format, keyval);
d1671 1
a1671 1
          strcpy(tpdsrc, "Polynomial distortion");
d1678 1
a1678 1
        sprintf(keyword, "C%cDIS%d", pq, j+1);
d1680 1
a1680 1
          strcpy(comment, "P = prior, ");
d1682 1
a1682 1
          strcpy(comment, "Q = sequent, ");
d1686 2
d1689 2
a1690 2
          strcpy(keyvalue, "'TPD'");
          strcat(comment, "Template Polynomial Distortion");
d1708 2
a1709 2
          strcpy(keyvalue, "'Polynomial'");
          strcat(comment, "general Polynomial distortion");
d1716 2
a1717 2
        sprintf(keyword,  "D%c%d", pq, j+1);
        sprintf(keyvalue, "'NAXES:  %d'", Nhat);
d1719 1
a1719 1
          strcpy(comment,  "One independent variable");
d1721 1
a1721 1
          strcpy(comment,  "Two independent variables");
d1723 1
a1723 1
          strcpy(comment,  "Number of independent variables");
d1731 1
a1731 1
          sprintf(keyvalue, "'AXIS.%d: %d'", jhat+1, axmap[jhat]+1);
d1733 1
a1733 1
            strcpy(comment, "1st");
d1735 1
a1735 1
            strcpy(comment, "2nd");
d1737 1
a1737 1
            strcpy(comment, "3rd");
d1739 1
a1739 1
            sprintf(comment, "%dth", jhat+1);
d1742 2
a1743 1
          sprintf(comment+strlen(comment), " independent variable: axis %d",
d1750 1
a1750 1
            sprintf(comment+strlen(comment), " (= %c)", cp[jhat]);
d1764 4
a1767 3
          wcsutil_double2str(ctemp, format, dis->offset[j][jhat]);
          sprintf(keyvalue, "'OFFSET.%d: %s'", jhat+1, ctemp);
          sprintf(comment, "Variable %d renormalization offset", jhat+1);
d1778 3
a1780 3
          wcsutil_double2str(ctemp, format, dis->scale[j][jhat]);
          sprintf(keyvalue, "'SCALE.%d: %s'", jhat+1, ctemp);
          sprintf(comment, "Variable %d renormalization scale", jhat+1);
d1804 1
a1804 1
          sprintf(fmt01, "%.3ss", format);
d1810 1
a1810 1
                sprintf(ctemp, fmt01, "0.0");
d1812 1
a1812 1
                sprintf(ctemp, fmt01, "1.0");
d1814 1
a1814 1
                wcsutil_double2str(ctemp, format, dparm[idp]);
d1818 2
a1819 2
                sprintf(keyvalue, "'AUX.1.COEFF.%d: %s'", idp%3, ctemp);
                sprintf(comment, "TPD: x = c0 + c1*u + c2*v");
d1821 2
a1822 2
                sprintf(keyvalue, "'AUX.2.COEFF.%d: %s'", idp%3, ctemp);
                sprintf(comment, "TPD: y = d0 + d1*u + d2*v");
d1838 1
a1838 1
              sprintf(ctemp, fmt01, "1.0");
d1840 1
a1840 1
              wcsutil_double2str(ctemp, format, dparm[idp]);
d1844 2
a1845 1
            sprintf(keyvalue, "'TPD.FWD.%d:%s %s'", m, (m<10)?" ":"", ctemp);
d1847 1
a1847 1
            sprintf(comment, "TPD coefficient: %s", term);
d1855 3
a1857 3
            sprintf(keyword,  "C%cERR%d", pq, j+1);
            sprintf(keyvalue, "%20.2f", dis->maxdis[j]);
            sprintf(comment, "%sMaximum absolute value of distortion",
d1870 1
a1870 1
          sprintf(keyword,  "D%c%d", pq, j+1);
d1874 1
a1874 1
            wcsutil_double2str(ctemp, format, dparm[idp]);
d1876 2
a1877 1
            sprintf(keyvalue, "'TPD.REV.%d:%s %s'", m, (m<10)?" ":"", ctemp);
d1879 1
a1879 1
            sprintf(comment, "TPD coefficient: %s", term);
d1897 1
a1897 1
            sprintf(keyvalue, "'%s: %d'", cp, dpkeyi(ikeyp));
d1913 1
a1913 1
              sprintf(keyvalue, "'%s:", cp);
a1915 1
              char *kp = keyvalue + strlen(keyvalue);
d1917 2
d1920 1
a1920 1
                sprintf(kp, "%4d'", (int)keyval);
d1922 1
a1922 1
                strcat(kp, " 0.5'");
d1924 4
a1927 2
                wcsutil_double2str(kp, "%21.13E", keyval);
                strcat(keyvalue, "'");
d1934 1
a1934 1
                  sprintf(comment, "Aux %d: var %d power", m, p);
d1936 1
a1936 1
                  sprintf(comment, "Aux %d: power of sum of terms", m);
d1940 1
a1940 1
                  sprintf(comment, "Aux %d: var %d coefficient", m, p);
d1942 1
a1942 1
                  sprintf(comment, "Aux %d: offset term", m);
d1961 1
a1961 1
            sprintf(keyvalue, "'%s: %d'", cp, dpkeyi(ikeyp));
d1978 1
a1978 1
            sprintf(keyvalue, "'%s:%s ", cp, (m<10)?" ":"");
d1981 2
a1982 1
            char *kp = keyvalue + strlen(keyvalue);
d1985 1
a1985 1
                sprintf(kp, "%20d", (int)keyval);
d1987 1
a1987 1
                wcsutil_double2str(kp, "%20.13f", keyval);
d1993 1
a1993 1
                sprintf(comment, "Poly term %d: var %d power", m, p);
d1995 2
a1996 1
                sprintf(comment, "Poly term %d: aux %d power", m, p-Nhat);
d2000 2
a2001 2
              wcsutil_double2str(kp, "%20.13E", keyval);
              sprintf(comment, "Poly term %d: coefficient", m);
d2003 4
a2006 1
            strcat(keyvalue, "'");
d2014 3
a2016 3
            sprintf(keyword,  "C%cERR%d", pq, j+1);
            sprintf(keyvalue, "%20.2f", dis->maxdis[j]);
            sprintf(comment, "%sMaximum absolute value of distortion",
d2027 2
a2028 2
      sprintf(keyvalue, "%20.2f", dis->totdis);
      sprintf(comment, "Maximum combined distortion");
d2041 1
a2041 1
    sprintf(comment, "Translated from %s to TPD by WCSLIB %s", tpdsrc,
d2044 1
a2044 1
    sprintf(comment, "WCS header keyrecords produced by WCSLIB %s",
d2061 1
a2061 1
void wcshdo_format(
d2065 1
a2065 1
  char *format)
d2075 1
a2075 1
    wcsutil_double2str(cval, "%21.14E", val[i]);
d2109 1
a2109 1
    sprintf(format, "%%20.%df", precision);
d2115 1
a2115 1
      sprintf(format, "%%20.%dE", precision);
d2117 1
a2117 1
      sprintf(format, "%%21.%dE", precision);
d2125 1
a2125 1
void wcshdo_tpdterm(
d2128 1
a2128 1
  char *term)
d2139 1
a2139 1
    strcpy(term, "1");
d2161 1
a2161 1
void wcshdo_util(
d2185 1
a2185 1
    int nbyte = ((*nkeyrec)/32 + 1) * 2880;
d2201 1
a2201 1
        sprintf(keyword, "%d%d%s%d%c", i, j, tbkey, btcol, alt);
d2203 1
a2203 1
        sprintf(keyword, "%d%s%d_%d%c", i, tbkey, btcol, m, alt);
d2206 1
a2206 1
      sprintf(keyword, "%d%s%d%c", i, tbkey, btcol, alt);
d2208 1
a2208 1
      sprintf(keyword, "%d%s%d%c", j, tbkey, btcol, alt);
d2210 1
a2210 1
      sprintf(keyword, "%s%d%c", tbkey, btcol, alt);
d2217 1
a2217 1
          sprintf(keyword, "%d%d%s%d%c", i, j, tlkey, btcol, alt);
d2219 1
a2219 1
          sprintf(keyword, "%d%s%d_%d%c", i, tlkey, btcol, m, alt);
d2222 1
a2222 1
        sprintf(keyword, "%d%s%d%c", i, tlkey, btcol, alt);
d2224 1
a2224 1
        sprintf(keyword, "%d%s%d%c", j, tlkey, btcol, alt);
d2226 1
a2226 1
        sprintf(keyword, "%s%d%c", tlkey, btcol, alt);
d2234 2
a2235 1
        sprintf(keyword, "T%s%d_%d%c", tbkey, plcol[i-1], plcol[j-1], alt);
d2237 1
a2237 1
        sprintf(keyword, "T%s%d_%d%c", tbkey, plcol[i-1], m, alt);
d2240 1
a2240 1
      sprintf(keyword, "T%s%d%c", tbkey, plcol[i-1], alt);
d2242 1
a2242 1
      sprintf(keyword, "T%s%d%c", tbkey, plcol[j-1], alt);
d2244 1
a2244 1
      sprintf(keyword, "%s%d%c", tbkey, plcol[0], alt);
d2251 2
a2252 1
          sprintf(keyword, "T%s%d_%d%c", tlkey, plcol[i-1], plcol[j-1], alt);
d2254 1
a2254 1
          sprintf(keyword, "T%s%d_%d%c", tlkey, plcol[i-1], m, alt);
d2257 1
a2257 1
        sprintf(keyword, "T%s%d%c", tlkey, plcol[i-1], alt);
d2259 1
a2259 1
        sprintf(keyword, "T%s%d%c", tlkey, plcol[j-1], alt);
d2261 1
a2261 1
        sprintf(keyword, "%s%d%c", tlkey, plcol[0], alt);
d2267 1
a2267 1
        sprintf(keyword, "%s%d_%d%c", pikey, i, j, alt);
d2269 1
a2269 1
        sprintf(keyword, "%s%d_%d%c", pikey, i, m, alt);
d2272 1
a2272 1
      sprintf(keyword, "%s%d%c", pikey, i, alt);
d2274 1
a2274 1
      sprintf(keyword, "%s%d%c", pikey, j, alt);
d2276 1
a2276 1
      sprintf(keyword, "%s%c", pikey, alt);
d2317 1
a2317 1
  if ((nv = strlen(keyvalue) > 20)) {
d2322 1
a2322 1
  hptr = *header + (80 * ((*nkeyrec)++));
d2324 1
a2324 1
    sprintf(hptr, "%80.80s", " ");
d2326 1
a2326 1
    sprintf(hptr, "%-8.8s %-71.71s", keyword, keycomment);
d2328 1
a2328 1
    sprintf(hptr, "%-8.8s= %-20s / %-*.*s", keyword, keyvalue, nc, nc,
@


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


8.6.1.2
log
@Found by Claude Code and cppcheck:
 - In wcshdo_util(), fixed a bug that would have caused the keycomment
   to be truncated for keyvalues exceeding 20 characters.
@
text
@d22 1
a22 1
  $Id: wcshdr.c,v 8.6.1.1 2026/03/29 14:19:26 mcalabre Exp mcalabre $
d2248 1
a2248 1
  if ((nv = strlen(keyvalue)) > 20) {
@


8.6.1.3
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: wcshdr.c,v 8.6.1.2 2026/04/04 13:05:27 mcalabre Exp mcalabre $
d64 2
a65 2
static void wcshdo_format(int, int, const double [], char [16]);
static void wcshdo_tpdterm(int, int, char [16]);
d161 1
a161 1
        strncpy(PSi_0a[itabax], wcs->ps[ip].value, 72);
d166 1
a166 1
        strncpy(PSi_1a[itabax], wcs->ps[ip].value, 72);
d171 1
a171 1
        strncpy(PSi_2a[itabax], wcs->ps[ip].value, 72);
d314 1
a314 1
        strncpy(wtbp->extnam, PSi_0a[itabax], 72);
d317 1
a317 1
        strncpy(wtbp->ttype, PSi_1a[itabax], 72);
d337 1
a337 1
        strncpy(wtbp->extnam, PSi_0a[itabax], 72);
d340 1
a340 1
        strncpy(wtbp->ttype, PSi_2a[itabax], 72);
d540 1
a540 1
    strncpy(format, "% 20.17G", 16);
d542 1
a542 1
    strncpy(format, "% 20.16G", 16);
d544 1
a544 1
    strncpy(format, "% 20.15G", 16);
d546 1
a546 1
    strncpy(format, "% 20.14G", 16);
d548 1
a548 1
    strncpy(format, "% 20.13G", 16);
d550 1
a550 1
    strncpy(format, "%20.12G", 16);
d566 1
a566 1
    snprintf(keyvalue, 96, "%20d", naxis);
d604 1
a604 1
    if (wcs->cunit[i][0]) snprintf(comment, 128, "[%s] ", wcs->cunit[i]);
d614 1
a614 1
    snprintf(keyvalue, 96, "'%s'", wcs->cunit[i]);
d661 1
a661 1
            strncpy(tpdsrc, "SIP coordinates", 24);
d698 1
a698 1
            strncpy(tpdsrc, "TPV \"projection\"", 24);
d709 1
a709 1
        strncpy(tpdsrc, dis->dtype[i], 24);
d714 1
a714 1
        strncpy(tpdsrc, dis->dtype[i]+4, 24);
d717 1
a717 1
          strncpy(tpdsrc, wcs->wcsname, 24);
d731 2
a732 2
    snprintf(keyvalue, 96, "'%s'", wcs->ctype[i]);
    strncpy(comment, "Coordinate type code", 128);
d739 1
a739 1
        strncpy(ctypei+8, "-SIP'", 6);
d742 1
a742 1
        strncpy(ctypei+4, "-TPV'", 6);
d746 1
a746 1
        strncpy(comment, "TAN (gnomonic) projection + SIP distortions", 128);
d749 1
a749 1
        strncpy(comment, "TAN (gnomonic) projection + distortions", 128);
d753 1
a753 1
          strncpy(comment, "Right ascension, ", 128);
d756 1
a756 1
          strncpy(comment, "Declination, ", 128);
d764 1
a764 1
            strncpy(comment, "Galactic l", 128);
d767 1
a767 1
            strncpy(comment, "Ecliptic l", 128);
d770 1
a770 1
            strncpy(comment, "Helioecliptic l", 128);
d773 1
a773 1
            strncpy(comment, "Supergalactic l", 128);
d777 1
a777 1
            strncpy(comment, "L", 128);
d821 1
a821 1
    if (wcs->cunit[i][0]) snprintf(comment, 128, "[%s] ", wcs->cunit[i]);
d828 1
a828 1
  if (dofmt) strncpy(format, "%20.12G", 16);
d834 1
a834 2
        strncpy(comment, "[deg] Native longitude of the reference point",
          128);
d837 1
a837 2
        strncpy(comment, "[deg] Native latitude  of the reference point",
          128);
d841 1
a841 1
          snprintf(keyword, 16, "LONPOLE%c", alt);
d843 1
a843 1
          snprintf(keyword, 16, "LONP%d%c", colnum, alt);
d845 1
a845 1
          snprintf(keyword, 16, "LONP%d%c", colax[(wcs->pv[k]).i - 1], alt);
d847 1
a847 2
        snprintf(comment, 128, "[deg] alias for %s (has precedence)",
          keyword);
d851 1
a851 1
          snprintf(keyword, 16, "LATPOLE%c", alt);
d853 1
a853 1
          snprintf(keyword, 16, "LATP%d%c", colnum, alt);
d855 1
a855 1
          snprintf(keyword, 16, "LATP%d%c", colax[(wcs->pv[k]).i - 1], alt);
d857 1
a857 2
        snprintf(comment, 128, "[deg] alias for %s (has precedence)",
          keyword);
d861 1
a861 1
      snprintf(comment, 128, "%s projection parameter", wcs->cel.prj.code);
d863 1
a863 1
      strncpy(comment, "Coordinate transformation parameter", 128);
d872 1
a872 1
    snprintf(keyvalue, 96, "'%s'", (wcs->ps[k]).value);
d907 1
a907 1
  snprintf(timeunit, 16, "%.15s", wcs->timeunit[0] ? wcs->timeunit : "s");
d914 1
a914 1
      snprintf(keyvalue, 96, "'%s'", wcs->cname[i]);
d928 1
a928 1
      if (wcs->cunit[i][0]) snprintf(comment, 128, "[%s] ", wcs->cunit[i]);
d942 1
a942 1
      if (wcs->cunit[i][0]) snprintf(comment, 128, "[%s] ", wcs->cunit[i]);
d955 1
a955 2
      snprintf(comment, 128, "[%s] Time at zero point of phase axis",
        timeunit);
d967 1
a967 1
      snprintf(comment, 128, "[%s] Period of phase axis", timeunit);
d977 1
a977 1
    snprintf(keyvalue, 96, "'%s'", wcs->wcsname);
d993 1
a993 1
    snprintf(keyvalue, 96, "'%s'", wcs->timesys);
d1000 1
a1000 1
    snprintf(keyvalue, 96, "'%s'", wcs->trefpos);
d1007 1
a1007 1
    snprintf(keyvalue, 96, "'%s'", wcs->trefdir);
d1014 1
a1014 1
    snprintf(keyvalue, 96, "'%s'", wcs->plephem);
d1022 1
a1022 1
    snprintf(keyvalue, 96, "'%s'", wcs->timeunit);
d1037 1
a1037 1
      snprintf(keyvalue, 96, "'%s'", wcs->dateref);
d1072 1
a1072 1
    snprintf(comment, 128, "[%s] Clock correction", timeunit);
d1081 2
a1082 2
    snprintf(keyvalue, 96, "'%s'", wcs->dateobs);
    strncpy(comment, "ISO-8601 time of observation", 128);
d1119 1
a1119 1
    snprintf(keyvalue, 96, "'%s'", wcs->datebeg);
d1135 1
a1135 1
    snprintf(comment, 128, "[%s] Time elapsed since fiducial time at start",
d1143 1
a1143 1
    snprintf(keyvalue, 96, "'%s'", wcs->dateavg);
d1159 1
a1159 1
    snprintf(keyvalue, 96, "'%s'", wcs->dateend);
d1175 1
a1175 1
    snprintf(comment, 128, "[%s] Time elapsed since fiducial time at end",
d1184 1
a1184 1
    snprintf(comment, 128, "[%s] Exposure (integration) time", timeunit);
d1192 1
a1192 1
    snprintf(comment, 128, "[%s] Elapsed time (start to stop)", timeunit);
d1202 1
a1202 2
    snprintf(comment, 128, "[%s] Systematic error in time measurements",
      timeunit);
d1210 1
a1210 2
    snprintf(comment, 128, "[%s] Relative error in time measurements",
      timeunit);
d1218 1
a1218 1
    snprintf(comment, 128, "[%s] Time resolution", timeunit);
d1241 1
a1241 1
      snprintf(comment, 128, "[m] observatory %c-coordinate", xyz[k]);
d1271 1
a1271 1
    snprintf(keyvalue, 96, "'%s'", wcs->obsorbit);
d1278 1
a1278 1
    snprintf(keyvalue, 96, "'%s'", wcs->radesys);
d1293 1
a1293 1
    snprintf(keyvalue, 96, "'%s'", wcs->specsys);
d1301 1
a1301 1
    snprintf(keyvalue, 96, "'%s'", wcs->ssysobs);
d1323 1
a1323 1
    snprintf(keyvalue, 96, "'%s'", wcs->ssyssrc);
d1451 1
a1451 1
      snprintf(format, 16, "%%20.%dE", precision);
d1461 1
a1461 1
        strncpy(keyword, "A_", 16);
d1463 1
a1463 1
        strncpy(keyword, "B_", 16);
d1472 3
a1474 4
      strncpy(keyword+2, "ORDER", 14);
      snprintf(keyvalue, 96, "%20d", degree);
      snprintf(comment, 128, "SIP polynomial degree, axis %d, pixel-to-sky",
        j+1);
d1486 1
a1486 1
        strncpy(keyword+2, cp, 14);
d1494 1
a1494 1
        snprintf(comment, 128, "SIP distortion coefficient: %s", term);
d1500 1
a1500 1
        strncpy(keyword+2, "DMAX", 14);
d1514 1
a1514 1
        strncpy(keyword, "AP_", 16);
d1516 1
a1516 1
        strncpy(keyword, "BP_", 16);
d1524 3
a1526 4
      strncpy(keyword+3, "ORDER", 13);
      snprintf(keyvalue, 96, "%20d", degree);
      snprintf(comment, 128, "SIP polynomial degree, axis %d, sky-to-pixel",
        j+1);
d1538 1
a1538 1
        strncpy(keyword+3, cp, 13);
d1546 1
a1546 1
        snprintf(comment, 128, "SIP inverse coefficient: %s", term);
d1572 1
a1572 1
        snprintf(fmt01, 8, "%.3ss", format);
d1578 1
a1578 1
        snprintf(keyword, 16, "PV%d_", j+1);
d1588 1
a1588 3

          size_t ksize = (ikeyp->field + 72) - kp;
          strncpy(kp, cp+4, ksize);
d1594 1
a1594 1
          snprintf(comment, 128, "TPV coefficient: %s", term);
d1597 1
a1597 1
            snprintf(keyvalue, 96, fmt01, "1.0");
d1618 1
a1618 1
          strncpy(tpdsrc, "Polynomial distortion", 24);
d1625 1
a1625 1
        snprintf(keyword, 16, "C%cDIS%d", pq, j+1);
d1627 1
a1627 1
          strncpy(comment, "P = prior, ", 128);
d1629 1
a1629 1
          strncpy(comment, "Q = sequent, ", 128);
d1634 1
a1634 1
          strncpy(keyvalue, "'TPD'", 96);
d1653 1
a1653 1
          strncpy(keyvalue, "'Polynomial'", 96);
d1661 2
a1662 2
        snprintf(keyword, 16,  "D%c%d", pq, j+1);
        snprintf(keyvalue, 96, "'NAXES:  %d'", Nhat);
d1664 1
a1664 1
          strncpy(comment,  "One independent variable", 128);
d1666 1
a1666 1
          strncpy(comment,  "Two independent variables", 128);
d1668 1
a1668 1
          strncpy(comment,  "Number of independent variables", 128);
d1676 1
a1676 1
          snprintf(keyvalue, 96, "'AXIS.%d: %d'", jhat+1, axmap[jhat]+1);
d1678 1
a1678 1
            strncpy(comment, "1st", 128);
d1680 1
a1680 1
            strncpy(comment, "2nd", 128);
d1682 1
a1682 1
            strncpy(comment, "3rd", 128);
d1684 1
a1684 1
            snprintf(comment, 128, "%dth", jhat+1);
d1687 1
a1687 2
          snprintf(comment, 128+strlen(comment),
            " independent variable: axis %d",
d1694 1
a1694 1
            snprintf(comment, 128+strlen(comment), " (= %c)", cp[jhat]);
d1709 2
a1710 3
          snprintf(keyvalue, 96, "'OFFSET.%d: %s'", jhat+1, ctemp);
          snprintf(comment, 128, "Variable %d renormalization offset",
            jhat+1);
d1722 2
a1723 2
          snprintf(keyvalue, 96, "'SCALE.%d: %s'", jhat+1, ctemp);
          snprintf(comment, 128, "Variable %d renormalization scale", jhat+1);
d1747 1
a1747 1
          snprintf(fmt01, 8, "%.3ss", format);
d1753 1
a1753 1
                snprintf(ctemp, 32, fmt01, "0.0");
d1755 1
a1755 1
                snprintf(ctemp, 32, fmt01, "1.0");
d1761 2
a1762 2
                snprintf(keyvalue, 96, "'AUX.1.COEFF.%d: %s'", idp%3, ctemp);
                snprintf(comment, 128, "TPD: x = c0 + c1*u + c2*v");
d1764 2
a1765 2
                snprintf(keyvalue, 96, "'AUX.2.COEFF.%d: %s'", idp%3, ctemp);
                snprintf(comment, 128, "TPD: y = d0 + d1*u + d2*v");
d1781 1
a1781 1
              snprintf(ctemp, 32, fmt01, "1.0");
d1787 1
a1787 2
            snprintf(keyvalue, 96, "'TPD.FWD.%d:%s %s'", m, (m<10)?" ":"",
              ctemp);
d1789 1
a1789 1
            snprintf(comment, 128, "TPD coefficient: %s", term);
d1797 3
a1799 3
            snprintf(keyword, 16,  "C%cERR%d", pq, j+1);
            snprintf(keyvalue, 96, "%20.2f", dis->maxdis[j]);
            snprintf(comment, 128, "%sMaximum absolute value of distortion",
d1812 1
a1812 1
          snprintf(keyword, 16,  "D%c%d", pq, j+1);
d1818 1
a1818 2
            snprintf(keyvalue, 96, "'TPD.REV.%d:%s %s'", m, (m<10)?" ":"",
              ctemp);
d1820 1
a1820 1
            snprintf(comment, 128, "TPD coefficient: %s", term);
d1838 1
a1838 1
            snprintf(keyvalue, 96, "'%s: %d'", cp, dpkeyi(ikeyp));
d1854 1
a1854 1
              snprintf(keyvalue, 96, "'%s:", cp);
d1860 1
a1860 2
                size_t ksize = (keyvalue + 96) - kp;
                snprintf(kp, ksize, "%4d'", (int)keyval);
d1872 1
a1872 1
                  snprintf(comment, 128, "Aux %d: var %d power", m, p);
d1874 1
a1874 1
                  snprintf(comment, 128, "Aux %d: power of sum of terms", m);
d1878 1
a1878 1
                  snprintf(comment, 128, "Aux %d: var %d coefficient", m, p);
d1880 1
a1880 1
                  snprintf(comment, 128, "Aux %d: offset term", m);
d1899 1
a1899 1
            snprintf(keyvalue, 96, "'%s: %d'", cp, dpkeyi(ikeyp));
d1916 1
a1916 1
            snprintf(keyvalue, 96, "'%s:%s ", cp, (m<10)?" ":"");
d1922 1
a1922 2
                size_t ksize = (keyvalue + 96) - kp;
                snprintf(kp, ksize, "%20d", (int)keyval);
d1930 1
a1930 1
                snprintf(comment, 128, "Poly term %d: var %d power", m, p);
d1932 1
a1932 2
                snprintf(comment, 128, "Poly term %d: aux %d power", m,
                  p-Nhat);
d1937 1
a1937 1
              snprintf(comment, 128, "Poly term %d: coefficient", m);
d1947 3
a1949 3
            snprintf(keyword, 16,  "C%cERR%d", pq, j+1);
            snprintf(keyvalue, 96, "%20.2f", dis->maxdis[j]);
            snprintf(comment, 128, "%sMaximum absolute value of distortion",
d1960 2
a1961 2
      snprintf(keyvalue, 96, "%20.2f", dis->totdis);
      snprintf(comment, 128, "Maximum combined distortion");
d1974 1
a1974 1
    snprintf(comment, 128, "Translated from %s to TPD by WCSLIB %s", tpdsrc,
d1977 1
a1977 1
    snprintf(comment, 128, "WCS header keyrecords produced by WCSLIB %s",
d1994 1
a1994 1
static void wcshdo_format(
d1998 1
a1998 1
  char format[16])
d2042 1
a2042 1
    snprintf(format, 16, "%%20.%df", precision);
d2048 1
a2048 1
      snprintf(format, 16, "%%20.%dE", precision);
d2050 1
a2050 1
      snprintf(format, 16, "%%21.%dE", precision);
d2058 1
a2058 1
static void wcshdo_tpdterm(
d2061 1
a2061 1
  char term[16])
d2072 1
a2072 1
    strncpy(term, "1", 16);
d2094 1
a2094 1
static void wcshdo_util(
d2118 1
a2118 1
    int nbyte = ((*nkeyrec)/32 + 1) * 2880 + 1;
d2134 1
a2134 1
        snprintf(keyword, 32, "%d%d%s%d%c", i, j, tbkey, btcol, alt);
d2136 1
a2136 1
        snprintf(keyword, 32, "%d%s%d_%d%c", i, tbkey, btcol, m, alt);
d2139 1
a2139 1
      snprintf(keyword, 32, "%d%s%d%c", i, tbkey, btcol, alt);
d2141 1
a2141 1
      snprintf(keyword, 32, "%d%s%d%c", j, tbkey, btcol, alt);
d2143 1
a2143 1
      snprintf(keyword, 32, "%s%d%c", tbkey, btcol, alt);
d2150 1
a2150 1
          snprintf(keyword, 32, "%d%d%s%d%c", i, j, tlkey, btcol, alt);
d2152 1
a2152 1
          snprintf(keyword, 32, "%d%s%d_%d%c", i, tlkey, btcol, m, alt);
d2155 1
a2155 1
        snprintf(keyword, 32, "%d%s%d%c", i, tlkey, btcol, alt);
d2157 1
a2157 1
        snprintf(keyword, 32, "%d%s%d%c", j, tlkey, btcol, alt);
d2159 1
a2159 1
        snprintf(keyword, 32, "%s%d%c", tlkey, btcol, alt);
d2167 1
a2167 2
        snprintf(keyword, 32, "T%s%d_%d%c", tbkey, plcol[i-1], plcol[j-1],
          alt);
d2169 1
a2169 1
        snprintf(keyword, 32, "T%s%d_%d%c", tbkey, plcol[i-1], m, alt);
d2172 1
a2172 1
      snprintf(keyword, 32, "T%s%d%c", tbkey, plcol[i-1], alt);
d2174 1
a2174 1
      snprintf(keyword, 32, "T%s%d%c", tbkey, plcol[j-1], alt);
d2176 1
a2176 1
      snprintf(keyword, 32, "%s%d%c", tbkey, plcol[0], alt);
d2183 1
a2183 2
          snprintf(keyword, 32, "T%s%d_%d%c", tlkey, plcol[i-1], plcol[j-1],
            alt);
d2185 1
a2185 1
          snprintf(keyword, 32, "T%s%d_%d%c", tlkey, plcol[i-1], m, alt);
d2188 1
a2188 1
        snprintf(keyword, 32, "T%s%d%c", tlkey, plcol[i-1], alt);
d2190 1
a2190 1
        snprintf(keyword, 32, "T%s%d%c", tlkey, plcol[j-1], alt);
d2192 1
a2192 1
        snprintf(keyword, 32, "%s%d%c", tlkey, plcol[0], alt);
d2198 1
a2198 1
        snprintf(keyword, 32, "%s%d_%d%c", pikey, i, j, alt);
d2200 1
a2200 1
        snprintf(keyword, 32, "%s%d_%d%c", pikey, i, m, alt);
d2203 1
a2203 1
      snprintf(keyword, 32, "%s%d%c", pikey, i, alt);
d2205 1
a2205 1
      snprintf(keyword, 32, "%s%d%c", pikey, j, alt);
d2207 1
a2207 1
      snprintf(keyword, 32, "%s%c", pikey, alt);
d2255 1
a2255 1
    snprintf(hptr, 81, "%80.80s", " ");
d2257 1
a2257 1
    snprintf(hptr, 81, "%-8.8s %-71.71s", keyword, keycomment);
d2259 1
a2259 1
    snprintf(hptr, 81, "%-8.8s= %-20s / %-*.*s", keyword, keyvalue, nc, nc,
@


8.6.1.4
log
@Argument list to wcsutil_double2str() changed to pass the buffer size.
@
text
@d22 1
a22 1
  $Id: wcshdr.c,v 8.6.1.3 2026/04/10 09:07:46 mcalabre Exp mcalabre $
d574 1
a574 1
    wcsutil_double2str(keyvalue, 96, format, wcs->crpix[j]);
d591 1
a591 1
      wcsutil_double2str(keyvalue, 96, format, wcs->pc[k]);
d602 1
a602 1
    wcsutil_double2str(keyvalue, 96, format, wcs->cdelt[i]);
d819 1
a819 1
    wcsutil_double2str(keyvalue, 96, format, wcs->crval[i]);
d830 1
a830 1
    wcsutil_double2str(keyvalue, 96, format, (wcs->pv[k]).value);
d884 1
a884 1
    wcsutil_double2str(keyvalue, 96, format, wcs->lonpole);
d891 1
a891 1
    wcsutil_double2str(keyvalue, 96, format, wcs->latpole);
d898 1
a898 1
    wcsutil_double2str(keyvalue, 96, format, wcs->restfrq);
d904 1
a904 1
    wcsutil_double2str(keyvalue, 96, format, wcs->restwav);
d930 1
a930 1
      wcsutil_double2str(keyvalue, 96, format, wcs->crder[i]);
d944 1
a944 1
      wcsutil_double2str(keyvalue, 96, format, wcs->csyer[i]);
d958 1
a958 1
      wcsutil_double2str(keyvalue, 96, format, wcs->czphs[i]);
d971 1
a971 1
      wcsutil_double2str(keyvalue, 96, format, wcs->cperi[i]);
d1035 1
a1035 1
    wcsutil_double2str(keyvalue, 96, format, 0.0);
d1050 1
a1050 1
        wcsutil_double2str(keyvalue, 96, format, wcs->mjdref[0]);
d1058 1
a1058 1
        wcsutil_double2str(keyvalue, 96, format, wcs->mjdref[0]);
d1066 1
a1066 1
        wcsutil_double2str(keyvalue, 96, format, wcs->mjdref[1]);
d1076 1
a1076 1
    wcsutil_double2str(keyvalue, 96, format, wcs->timeoffs);
d1102 1
a1102 1
    wcsutil_double2str(keyvalue, 96, format, wcs->mjdobs);
d1109 1
a1109 1
    wcsutil_double2str(keyvalue, 96, format, wcs->jepoch);
d1116 1
a1116 1
    wcsutil_double2str(keyvalue, 96, format, wcs->bepoch);
d1132 1
a1132 1
    wcsutil_double2str(keyvalue, 96, format, wcs->mjdbeg);
d1139 1
a1139 1
    wcsutil_double2str(keyvalue, 96, format, wcs->tstart);
d1156 1
a1156 1
    wcsutil_double2str(keyvalue, 96, format, wcs->mjdavg);
d1172 1
a1172 1
    wcsutil_double2str(keyvalue, 96, format, wcs->mjdend);
d1179 1
a1179 1
    wcsutil_double2str(keyvalue, 96, format, wcs->tstop);
d1188 1
a1188 1
    wcsutil_double2str(keyvalue, 96, format, wcs->xposure);
d1196 1
a1196 1
    wcsutil_double2str(keyvalue, 96, format, wcs->telapse);
d1206 1
a1206 1
    wcsutil_double2str(keyvalue, 96, format, wcs->timsyer);
d1215 1
a1215 1
    wcsutil_double2str(keyvalue, 96, format, wcs->timrder);
d1224 1
a1224 1
    wcsutil_double2str(keyvalue, 96, format, wcs->timedel);
d1232 1
a1232 1
    wcsutil_double2str(keyvalue, 96, format, wcs->timepixr);
d1247 1
a1247 1
      wcsutil_double2str(keyvalue, 96, format, wcs->obsgeo[k]);
d1260 1
a1260 1
    wcsutil_double2str(keyvalue, 96, format, wcs->obsgeo[3]);
d1265 1
a1265 1
    wcsutil_double2str(keyvalue, 96, format, wcs->obsgeo[4]);
d1270 1
a1270 1
    wcsutil_double2str(keyvalue, 96, format, wcs->obsgeo[5]);
d1292 1
a1292 1
    wcsutil_double2str(keyvalue, 96, format, wcs->equinox);
d1316 1
a1316 1
    wcsutil_double2str(keyvalue, 96, format, wcs->velosys);
d1323 1
a1323 1
    wcsutil_double2str(keyvalue, 96, format, wcs->zsource);
d1338 1
a1338 1
    wcsutil_double2str(keyvalue, 96, format, wcs->velangl);
d1348 1
a1348 1
      wcsutil_double2str(keyvalue, 96, format, aux->rsun_ref);
d1354 1
a1354 1
      wcsutil_double2str(keyvalue, 96, format, aux->dsun_obs);
d1361 1
a1361 1
      wcsutil_double2str(keyvalue, 96, format, aux->crln_obs);
d1367 1
a1367 1
        wcsutil_double2str(keyvalue, 96, format, aux->hglt_obs);
d1375 1
a1375 1
      wcsutil_double2str(keyvalue, 96, format, aux->hgln_obs);
d1381 1
a1381 1
        wcsutil_double2str(keyvalue, 96, format, aux->hglt_obs);
d1389 1
a1389 1
      wcsutil_double2str(keyvalue, 96, format, aux->a_radius);
d1396 1
a1396 1
      wcsutil_double2str(keyvalue, 96, format, aux->b_radius);
d1403 1
a1403 1
      wcsutil_double2str(keyvalue, 96, format, aux->c_radius);
d1410 1
a1410 1
      wcsutil_double2str(keyvalue, 96, format, aux->blon_obs);
d1417 1
a1417 1
      wcsutil_double2str(keyvalue, 96, format, aux->blat_obs);
d1424 1
a1424 1
      wcsutil_double2str(keyvalue, 96, format, aux->bdis_obs);
d1448 1
a1448 1
        wcsutil_double2str(keyvalue, 96, "%20.13E", dpkeyd(ikeyp));
d1501 1
a1501 1
        wcsutil_double2str(keyvalue, 96, format, keyval);
d1509 1
a1509 1
        wcsutil_double2str(keyvalue, 96, "%20.3f", dis->maxdis[j]);
d1554 1
a1554 1
        wcsutil_double2str(keyvalue, 96, format, keyval);
d1610 1
a1610 1
            wcsutil_double2str(keyvalue, 96, format, keyval);
d1720 1
a1720 1
          wcsutil_double2str(ctemp, 32, format, dis->offset[j][jhat]);
d1734 1
a1734 1
          wcsutil_double2str(ctemp, 32, format, dis->scale[j][jhat]);
d1770 1
a1770 1
                wcsutil_double2str(ctemp, 32, format, dparm[idp]);
d1796 1
a1796 1
              wcsutil_double2str(ctemp, 32, format, dparm[idp]);
d1830 1
a1830 1
            wcsutil_double2str(ctemp, 32, format, dparm[idp]);
d1880 1
a1880 2
                size_t ksize = (keyvalue + 96) - kp;
                wcsutil_double2str(kp, ksize, "%21.13E", keyval);
d1941 1
a1941 2
                size_t ksize = (keyvalue + 96) - kp;
                wcsutil_double2str(kp, ksize, "%20.13f", keyval);
d1954 1
a1954 2
                size_t ksize = (keyvalue + 96) - kp;
              wcsutil_double2str(kp, ksize, "%20.13E", keyval);
d2026 1
a2026 1
    wcsutil_double2str(cval, 24, "%21.14E", val[i]);
@


8.6.1.5
log
@Further inconsequential changes prompted by clang-tidy:
 - Restructured an if-block in wcshdo() to disguise a repetition
   (bugprone-branch-clone).
 - Added explicit casts for memory size calculations
   (bugprone-implicit-widening-of-multiplication-result).
 - Added explicit casts for assignments as required
   (bugprone-narrowing-conversions).
 - Explicitly test the return value of strncmp() in if-statements
   (bugprone-suspicious-string-compare).
 - Added default cases to switches
   (bugprone-switch-missing-default-case).
 - Replaced use of strcat() with strncat()
   (clang-analyzer-security.insecureAPI.strcpy).
@
text
@d22 1
a22 1
  $Id: wcshdr.c,v 8.6.1.4 2026/04/10 09:23:47 mcalabre Exp mcalabre $
a27 1
#include <stddef.h>
a173 2
      default:
        // Undefined (ignored).
a193 2
      default:
        // Undefined (ignored).
d407 1
a407 3
  // End of the array.
  short *ipend = alts[0] + (ptrdiff_t)(28*1000);
  for (short *ip = alts[0]; ip < ipend; ip++) {
d420 1
a420 1
  for (short iwcs = 0; iwcs < (short)nwcs; iwcs++, wcsp++) {
d432 1
a432 1
          alts[wcsp->colax[i]][a] = iwcs;
d436 1
a436 1
        alts[0][a] = iwcs;
d446 1
a446 1
        alts[0][a] = iwcs;
d605 1
a605 1
    strncat(comment, "Coordinate increment at reference point", 128);
d634 1
a634 1
        if (!dotpd) {
d653 2
a654 4
          }

          if (strncmp(wcs->ctype[0], "RA---TAN", 8) != 0 ||
              strncmp(wcs->ctype[1], "DEC--TAN", 8) != 0) {
d719 1
a719 1
          strncat(tpdsrc, " \"projection\"", 24);
d760 1
a760 1
          ctypei[0] = (char)toupper((unsigned char)ctypei[0]);
d782 1
a782 1
            strncat(comment, "ongitude, ", 128);
d784 1
a784 1
            strncat(comment, "atitude, ", 128);
d788 2
a789 2
        strncat(comment, wcs->cel.prj.name, 128);
        strncat(comment, " projection", 128);
d796 1
a796 1
        strncat(comment, " (linear)", 128);
d800 1
a800 1
          strncat(comment, " (linear in frequency)", 128);
d803 1
a803 1
          strncat(comment, " (linear in velocity)", 128);
d806 1
a806 1
          strncat(comment, " (linear in wavelength)", 128);
a807 2
        default:
          strncat(comment, " (not recognised)", 128);
d822 1
a822 1
    strncat(comment, "Coordinate value at reference point", 128);
a862 2
      default:
        strncat(comment, " (not recognised)", 128);
d933 1
a933 1
      strncat(comment, "Random error in coordinate", 128);
d947 1
a947 1
      strncat(comment, "Systematic error in coordinate", 128);
d1646 1
a1646 1
          strncat(comment, "Template Polynomial Distortion", 128);
d1665 1
a1665 1
          strncat(comment, "general Polynomial distortion", 128);
a1873 1
              size_t ksize = (keyvalue + 96) - kp;
d1875 1
d1878 1
a1878 1
                strncat(kp, " 0.5'", ksize);
d1880 1
d1882 1
a1882 1
                strncat(keyvalue, "'", ksize);
d1960 1
a1960 1
            strncat(keyvalue, "'", 96);
d2271 1
a2271 1
  if ((nv = (int)strlen(keyvalue)) > 20) {
d2276 1
a2276 1
  hptr = *header + (ptrdiff_t)(80*((*nkeyrec)++));
@


8.6.1.6
log
@Replaced all instances of strncat() with strncpy() with explicit computation
of the remaining buffer size.
@
text
@d22 1
a22 1
  $Id: wcshdr.c,v 8.6.1.5 2026/04/21 06:46:49 mcalabre Exp mcalabre $
d506 3
a514 1
  int status = 0;
a569 4
  char keyword[16],  *kwe = keyword  + 16;
  char keyvalue[96], *kve = keyvalue + 96;
  char comment[128], *cme = comment + 128;

d612 1
a612 3
    char *cm = comment + strlen(comment);
    size_t csize = cme - cm;
    strncpy(cm, "Coordinate increment at reference point", csize);
d728 1
a728 3
          char *tp = tpdsrc + strlen(tpdsrc);
          size_t tsize = (tpdsrc + 24) - tp;
          strncpy(tp, " \"projection\"", tsize);
a789 2
          char *cm = comment + strlen(comment);
          size_t csize = cme - cm;
d791 1
a791 1
            strncpy(cm, "ongitude, ", csize);
d793 1
a793 1
            strncpy(cm, "atitude, ", csize);
d797 2
a798 7
        char *cm = comment + strlen(comment);
        size_t csize = cme - cm;
        strncpy(cm, wcs->cel.prj.name, csize);

        cm += strlen(cm);
        csize = cme - cm;
        strncpy(cm, " projection", csize);
a803 4

      char *cm = comment + strlen(comment);
      size_t csize = cme - cm;

d805 1
a805 1
        strncpy(cm, " (linear)", csize);
d809 1
a809 1
          strncpy(cm, " (linear in frequency)", csize);
d812 1
a812 1
          strncpy(cm, " (linear in velocity)", csize);
d815 1
a815 1
          strncpy(cm, " (linear in wavelength)", csize);
d818 1
a818 1
          strncpy(cm, " (not recognised)", csize);
d833 1
a833 3
    char *cm = comment + strlen(comment);
    size_t csize = cme - cm;
    strncpy(cm, "Coordinate value at reference point", csize);
d875 1
a875 3
        char *cm = comment + strlen(comment);
        size_t csize = cme - cm;
        strncpy(cm, " (not recognised)", csize);
d946 1
a946 3
      char *cm = comment + strlen(comment);
      size_t csize = cme - cm;
      strncpy(cm, "Random error in coordinate", csize);
d960 1
a960 3
      char *cm = comment + strlen(comment);
      size_t csize = cme - cm;
      strncpy(cm, "Systematic error in coordinate", csize);
d1601 1
a1601 1
        char *kw = keyword + strlen(keyword);
d1611 2
a1612 2
          size_t ksize = kwe - kw;
          strncpy(kw, cp+4, ksize);
a1656 2
        char *cm = comment + strlen(comment);
        size_t csize = cme - cm;
d1659 1
a1659 1
          strncpy(cm, "Template Polynomial Distortion", csize);
d1678 1
a1678 1
          strncpy(cm, "general Polynomial distortion", csize);
d1719 1
a1719 1
            snprintf(comment, 128-strlen(comment), " (= %c)", cp[jhat]);
d1885 1
d1887 1
a1887 2
              char *kv = keyvalue + strlen(keyvalue);
              size_t ksize = kve - kv;
d1889 1
a1889 1
                snprintf(kv, ksize, "%4d'", (int)keyval);
d1891 1
a1891 1
                strncpy(kv, " 0.5'", ksize);
d1893 2
a1894 4
                wcsutil_double2str(kv, ksize, "%21.13E", keyval);
                kv += strlen(kv);
                ksize = kve - kv;
                strncpy(kv, "'", ksize);
d1948 1
a1948 2
            char *kv = keyvalue + strlen(keyvalue);
            size_t ksize = kve - kv;
d1951 2
a1952 1
                snprintf(kv, ksize, "%20d", (int)keyval);
d1954 2
a1955 1
                wcsutil_double2str(kv, ksize, "%20.13f", keyval);
d1968 2
a1969 1
              wcsutil_double2str(kv, ksize, "%20.13E", keyval);
d1972 1
a1972 4

            kv += strlen(kv);
            ksize = kve - kv;
            strncpy(kv, "'", ksize);
@


8.6.1.7
log
@Appeased pedantic compiler warnings.
@
text
@d22 1
a22 1
  $Id: wcshdr.c,v 8.6.1.6 2026/04/22 15:18:58 mcalabre Exp mcalabre $
a176 1
        break;
a198 1
        break;
a835 1
          break;
d893 1
a893 1
      default:;
a896 1
        break;
@


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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.c,v 8.2.1.5 2024/05/13 05:14:44 mcalabre Exp mcalabre $
@


8.3.1.1
log
@WCSLIB 8.3 development branch.
@
text
@d22 1
a22 1
  $Id: wcshdr.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: wcshdr.c,v 8.1.1.5 2023/11/14 13:42:34 mcalabre Exp mcalabre $
a39 4
extern const int WCSSET;

extern const int DIS_DOTPD;

d59 3
a61 2
// Convenience macro for invoking wcserr_set().
#define WCSHDR_ERRMSG(status) WCSERR_SET(status), wcshdr_errmsg[status]
d70 3
d508 1
a508 1
  if (wcs->flag != WCSSET) {
d1632 1
a1632 1
        int direct = 0, doaux;
@


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


8.2.1.2
log
@Defined WCSSET locally as a static variable matching that in wcs.c, and
likewise DIS_DOTPD matching dis.c.
@
text
@d22 1
a22 1
  $Id: wcshdr.c,v 8.2.1.1 2023/11/16 10:05:57 mcalabre Exp mcalabre $
d40 4
d63 2
a64 3
static const int WCSSET    =  137;	// Matching wcs.c

static const int DIS_DOTPD = 1024;	// Matching dis.c
a71 3

// Convenience macro for invoking wcserr_set().
#define WCSHDR_ERRMSG(status) WCSERR_SET(status), wcshdr_errmsg[status]
@


8.2.1.3
log
@In wcshdo(), quell a compiler warning about doaux being uninitialised.
@
text
@d22 1
a22 1
  $Id: wcshdr.c,v 8.2.1.2 2023/11/29 07:42:43 mcalabre Exp mcalabre $
d1632 1
a1632 1
        int direct = 0, doaux = 0;
@


8.2.1.4
log
@Updated date in copyright notice.
@
text
@d3 1
a3 1
  Copyright (C) 1995-2024, Mark Calabretta
d22 1
a22 1
  $Id: wcshdr.c,v 8.2.1.3 2023/12/20 12:46:50 mcalabre Exp mcalabre $
@


8.2.1.5
log
@In wcshdo(), support bypass mode in wcsset().
@
text
@d22 1
a22 1
  $Id: wcshdr.c,v 8.2.1.4 2024/04/02 14:01:58 mcalabre Exp mcalabre $
d508 1
a508 1
  if (abs(wcs->flag) != WCSSET) {
@


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: wcshdr.c,v 8.0.1.1 2023/07/01 06:22:44 mcalabre Exp mcalabre $
d80 1
d82 4
a85 5
  int  *PVi_1a = 0x0, *PVi_2a = 0x0, *PVi_3a = 0x0, *tabax, *tabidx = 0x0;
  int   getcrd, i, ip, itab, itabax, j, jtabax, m, naxis, ntabax, status;
  struct wtbarr *wtbp;
  struct tabprm *tabp;
  struct wcserr **err;
d88 1
a88 1
  err = &(wcs->err);
d97 1
a97 1
      for (j = 0; j < wcs->ntab; j++) {
d112 2
a113 1
  naxis = wcs->naxis;
d118 2
a119 2
  ntabax = 0;
  for (i = 0; i < naxis; i++) {
a131 1
    status = 0;
d148 1
a148 1
  for (itabax = 0; itabax < ntabax; itabax++) {
d155 2
a156 2
  for (ip = 0; ip < wcs->nps; ip++) {
    itabax = tabax[wcs->ps[ip].i - 1];
d178 2
a179 2
  for (ip = 0; ip < wcs->npv; ip++) {
    itabax = tabax[wcs->pv[ip].i - 1];
d200 1
a200 1
  for (itabax = 0; itabax < ntabax; itabax++) {
d209 2
a210 1
    for (jtabax = 0; jtabax < i; jtabax++) {
d235 2
a236 2
  for (itabax = 0; itabax < ntabax; itabax++) {
    tabp = wcs->tab + tabidx[itabax];
d244 1
a244 1
  for (itab = 0; itab < wcs->ntab; itab++) {
d253 2
a254 1
  for (i = 0; i < naxis; i++) {
d261 1
a261 1
    m = PVi_3a[itabax] - 1;
d263 1
d270 2
a271 2
  for (itab = 0; itab < wcs->ntab; itab++) {
    for (m = 0; m < wcs->tab[itab].M; m++) {
d282 1
a282 1
  for (itabax = 0; itabax < ntabax; itabax++) {
d302 4
a305 4
  wtbp = wcs->wtb;
  for (itab = 0; itab < wcs->ntab; itab++) {
    getcrd = 1;
    for (itabax = 0; itabax < ntabax; itabax++) {
d336 1
a336 1
        m = wtbp->m - 1;
a353 2
  status = 0;

d377 1
a377 4
  int a, iwcs;
  struct wcsprm *wcsp;

  for (a = 0; a < 27; a++) {
d385 2
a386 2
  wcsp = *wcs;
  for (iwcs = 0; iwcs < nwcs; iwcs++, wcsp++) {
d389 1
d407 1
a407 5
  short  *ip;
  int    a, i, icol, iwcs;
  struct wcsprm *wcsp;

  for (ip = alts[0]; ip < alts[0] + 28*1000; ip++) {
d411 1
a411 1
  for (icol = 0; icol < 1000; icol++) {
d419 3
a421 2
  wcsp = *wcs;
  for (iwcs = 0; iwcs < nwcs; iwcs++, wcsp++) {
d431 1
a431 1
        for (i = 0; i < wcsp->naxis; i++) {
d460 1
a460 2
  int a, status = 0;
  struct wcsprm *wcsp;
d466 2
a467 2
  wcsp = *wcs;
  for (a = 0; a < *nwcs; a++, wcsp++) {
d499 2
a500 12
  char alt, comment[72], ctemp[32], *ctypei, format[16], fmt01[8],
       keyvalue[96], keyword[16], *kp, obsg[8] = "OBSG?",
       obsgeo[8] = "OBSGEO-?", pq, ptype, xtype, term[16], timeunit[16],
       tpdsrc[24], xyz[] = "XYZ";
  int  *axmap, bintab, *colax, colnum, degree, direct = 0, doaux = 0, dofmt,
       dosip, dotpd, dotpv, i, idis, idp, *iparm, j, jhat, k, kp0, kpi, m,
       naxis, ncoeff, Nhat, p, pixlist, precision, primage, q, status = 0;
  double *dparm, keyval;
  struct auxprm *aux;
  struct disprm *dis;
  struct dpkey  *keyp;
  struct wcserr **err;
d506 1
a506 1
  err = &(wcs->err);
d512 1
d519 1
a519 1
  alt = wcs->alt[0];
d521 2
a522 2
  colnum = wcs->colnum;
  colax  = wcs->colax;
d524 3
a526 3
  primage = 0;
  bintab  = 0;
  pixlist = 0;
d537 1
d561 1
a561 1
  dofmt = (*format == '\0');
d573 1
a573 1
  for (j = 0; j < naxis; j++) {
d582 3
a584 3
  k = 0;
  for (i = 0; i < naxis; i++) {
    for (j = 0; j < naxis; j++, k++) {
d601 1
a601 1
  for (i = 0; i < naxis; i++) {
d611 1
a611 1
  for (i = 0; i < naxis; i++) {
d623 3
a625 3
  dosip = 0;
  dotpv = 0;
  dotpd = 0;
d628 1
a628 1
    for (i = 0; i < naxis; i++) {
d673 1
a673 1
    for (i = 0; i < naxis; i++) {
d728 1
a728 1
  for (i = 0; i < naxis; i++) {
d734 1
a734 1
    ctypei = keyvalue + 1;
d764 1
a764 1
            strcpy(comment, "galactic ");
d767 1
a767 1
            strcpy(comment, "ecliptic ");
d770 1
a770 1
            strcpy(comment, "helioecliptic ");
d773 5
a777 1
            strcpy(comment, "supergalactic ");
d782 1
a782 1
            strcat(comment, "longitude, ");
d784 1
a784 1
            strcat(comment, "latitude, ");
d793 1
d817 1
a817 1
  for (i = 0; i < naxis; i++) {
d829 1
a829 1
  for (k = 0; k < wcs->npv; k++) {
d867 2
a868 2
      wcs->pv[k].m, alt, colnum, colax, keyvalue, comment,
      nkeyrec, header, &status);
d871 1
a871 1
  for (k = 0; k < wcs->nps; k++) {
d875 1
a875 2
      "Coordinate transformation parameter",
      nkeyrec, header, &status);
d881 3
a883 3
    wcshdo_util(ctrl, "LONPOLE", "LONP", 0, 0x0, 0, 0, 0, alt,
      colnum, colax, keyvalue, "[deg] Native longitude of celestial pole",
      nkeyrec, header, &status);
d888 3
a890 3
    wcshdo_util(ctrl, "LATPOLE", "LATP", 0, 0x0, 0, 0, 0, alt,
      colnum, colax, keyvalue, "[deg] Native latitude of celestial pole",
      nkeyrec, header, &status);
d895 2
a896 3
    wcshdo_util(ctrl, "RESTFRQ", "RFRQ", 0, 0x0, 0, 0, 0, alt,
      colnum, colax, keyvalue, "[Hz] Line rest frequency",
      nkeyrec, header, &status);
d901 2
a902 3
    wcshdo_util(ctrl, "RESTWAV", "RWAV", 0, 0x0, 0, 0, 0, alt,
      colnum, colax, keyvalue, "[Hz] Line rest wavelength",
      nkeyrec, header, &status);
d906 1
d911 1
a911 1
    for (i = 0; i < naxis; i++) {
d923 1
a923 1
    for (i = 0; i < naxis; i++) {
d937 1
a937 1
    for (i = 0; i < naxis; i++) {
d951 1
a951 1
    for (i = 0; i < naxis; i++) {
d963 1
a963 1
    for (i = 0; i < naxis; i++) {
d979 2
a980 3
      wcshdo_util(ctrl, "WCSNAME", "WCSN", 0, 0x0, 0, 0, 0, alt,
        colnum, colax, keyvalue, "Coordinate system title",
        nkeyrec, header, &status);
d994 2
a995 2
    wcshdo_util(ctrl, "TIMESYS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "Time scale", nkeyrec, header, &status);
d1001 2
a1002 2
    wcshdo_util(ctrl, "TREFPOS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "Time reference position", nkeyrec, header, &status);
d1008 2
a1009 2
    wcshdo_util(ctrl, "TREFDIR", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "Time reference direction", nkeyrec, header, &status);
d1015 3
a1017 2
    wcshdo_util(ctrl, "PLEPHEM", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "Ephemerides used for pathlength delays", nkeyrec, header, &status);
d1023 2
a1024 2
    wcshdo_util(ctrl, "TIMEUNIT", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "Time units", nkeyrec, header, &status);
d1031 2
a1032 2
    wcshdo_util(ctrl, "MJDREF", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "[d] MJD of fiducial time", nkeyrec, header, &status);
d1073 2
a1074 2
    wcshdo_util(ctrl, "TIMEOFFS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      comment, nkeyrec, header, &status);
d1090 2
a1091 2
      wcshdo_util(ctrl, "DATE-OBS", 0x0, 0, 0x0, 0, 0, 0, ' ',
        0, 0x0, keyvalue, comment, nkeyrec, header, &status);
d1098 2
a1099 3
    wcshdo_util(ctrl, "MJD-OBS", "MJDOB", 0, 0x0, 0, 0, 0, ' ',
      colnum, colax, keyvalue, "[d] MJD of observation",
      nkeyrec, header, &status);
d1105 2
a1106 2
    wcshdo_util(ctrl, "JEPOCH", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "[a] Julian epoch of observation", nkeyrec, header, &status);
d1112 3
a1114 2
    wcshdo_util(ctrl, "BEPOCH", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "[a] Besselian epoch of observation", nkeyrec, header, &status);
d1120 3
a1122 2
    wcshdo_util(ctrl, "DATE-BEG", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "ISO-8601 time at start of observation", nkeyrec, header, &status);
d1128 2
a1129 2
    wcshdo_util(ctrl, "MJD-BEG", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "[d] MJD at start of observation", nkeyrec, header, &status);
d1137 2
a1138 2
    wcshdo_util(ctrl, "TSTART", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      comment, nkeyrec, header, &status);
d1144 3
a1146 3
    wcshdo_util(ctrl, "DATE-AVG", "DAVG", 0, 0x0, 0, 0, 0, ' ',
      colnum, colax, keyvalue, "ISO-8601 time at midpoint of observation",
      nkeyrec, header, &status);
d1152 3
a1154 3
    wcshdo_util(ctrl, "MJD-AVG", "MJDA", 0, 0x0, 0, 0, 0, ' ',
      colnum, colax, keyvalue, "[d] MJD at midpoint of observation",
      nkeyrec, header, &status);
d1160 3
a1162 2
    wcshdo_util(ctrl, "DATE-END", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "ISO-8601 time at end of observation", nkeyrec, header, &status);
d1168 2
a1169 2
    wcshdo_util(ctrl, "MJD-END", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "[d] MJD at end of observation", nkeyrec, header, &status);
d1177 2
a1178 2
    wcshdo_util(ctrl, "TSTOP", "", 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      comment, nkeyrec, header, &status);
d1185 2
a1186 2
    wcshdo_util(ctrl, "XPOSURE", "", 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      comment, nkeyrec, header, &status);
d1193 2
a1194 2
    wcshdo_util(ctrl, "TELAPSE", "", 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      comment, nkeyrec, header, &status);
d1203 2
a1204 2
    wcshdo_util(ctrl, "TIMSYER", "", 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      comment, nkeyrec, header, &status);
d1211 2
a1212 2
    wcshdo_util(ctrl, "TIMRDER", "", 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      comment, nkeyrec, header, &status);
d1219 2
a1220 2
    wcshdo_util(ctrl, "TIMEDEL", "", 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      comment, nkeyrec, header, &status);
d1226 3
a1228 3
    wcshdo_util(ctrl, "TIMEPIXR", "", 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "Reference position of timestamp in binned data", nkeyrec, header,
      &status);
d1238 2
a1239 1
    for (k = 0; k < 3; k++) {
d1244 2
a1245 2
      wcshdo_util(ctrl, obsgeo, obsg, 0, 0x0, 0, 0, 0, ' ',
        colnum, colax, keyvalue, comment, nkeyrec, header, &status);
d1254 3
a1256 2
    wcshdo_util(ctrl, "OBSGEO-L", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "[deg] IAU(1976) observatory longitude", nkeyrec, header, &status);
d1259 3
a1261 2
    wcshdo_util(ctrl, "OBSGEO-B", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "[deg] IAU(1976) observatory latitude", nkeyrec, header, &status);
d1264 3
a1266 2
    wcshdo_util(ctrl, "OBSGEO-L", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "[m]   IAU(1976) observatory height", nkeyrec, header, &status);
d1272 2
a1273 2
    wcshdo_util(ctrl, "OBSORBIT", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "Spacecraft orbit ephemeris file", nkeyrec, header, &status);
d1338 1
d1426 3
d1436 4
a1439 4
      keyp = dis->dp;
      kp0  = 2;
      for (idp = 0; idp < dis->ndp; idp++, keyp++) {
        cp = strchr(keyp->field, '.') + 1;
d1441 1
a1441 1
        wcsutil_double2str(keyvalue, "%20.13E", dpkeyd(keyp));
d1443 1
a1443 1
        kpi = 15;
d1448 1
a1448 1
      precision = kp0 - 2;
d1455 1
a1455 1
    for (j = 0; j <= 1; j++) {
d1457 2
a1458 2
      wcshdo_util(ctrl, "", "", 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
        nkeyrec, header, &status);
d1466 2
a1467 1
      ncoeff = dis->iparm[j][I_TPDNCO];
d1475 1
a1475 1
      wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, ' ', 0, 0,
d1478 4
a1481 4
      keyp = dis->dp;
      for (idp = 0; idp < dis->ndp; idp++, keyp++) {
        if (keyp->j != j+1) continue;
        if ((keyval = dpkeyd(keyp)) == 0.0) continue;
d1483 1
a1483 1
        cp = strchr(keyp->field, '.') + 1;
d1487 1
d1495 1
a1495 1
        wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, ' ', 0, 0,
d1502 1
a1502 1
        wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, ' ', 0, 0,
d1510 2
a1511 2
      wcshdo_util(ctrl, "", "", 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
        nkeyrec, header, &status);
d1527 1
a1527 1
      wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, ' ', 0, 0,
d1530 4
a1533 4
      keyp = dis->dp;
      for (idp = 0; idp < dis->ndp; idp++, keyp++) {
        if (keyp->j != j+1) continue;
        if ((keyval = dpkeyd(keyp)) == 0.0) continue;
d1535 1
a1535 1
        cp = strchr(keyp->field, '.') + 1;
d1539 1
d1547 1
a1547 1
        wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, ' ', 0, 0,
d1553 1
a1553 1
  for (idis = 0; idis < 2; idis++) {
d1557 1
a1557 1
    for (j = 0; j < naxis; j++) {
d1560 1
a1560 1
      iparm = dis->iparm[j];
d1571 1
d1574 2
a1575 2
        wcshdo_util(ctrl, "", "", 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
          nkeyrec, header, &status);
d1579 1
a1579 1
        kp = keyword + strlen(keyword);
d1581 4
a1584 4
        keyp = dis->dp;
        for (idp = 0; idp < dis->ndp; idp++, keyp++) {
          if (keyp->j != j+1) continue;
          if ((keyval = dpkeyd(keyp)) == 0.0) continue;
d1586 1
a1586 1
          cp = strchr(keyp->field, '.') + 1;
d1591 1
d1601 1
a1601 1
          wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1609 2
a1610 2
        wcshdo_util(ctrl, "", "", 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
          nkeyrec, header, &status);
d1621 2
a1622 2
        pq = idis ? 'Q' : 'P';
        Nhat = dis->Nhat[j];
d1632 1
d1638 1
a1638 1
          axmap  = dis->axmap[j];
d1657 1
a1657 1
        wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1670 1
a1670 1
        wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1674 2
a1675 2
        for (jhat = 0; jhat < Nhat; jhat++) {
          axmap = dis->axmap[j];
d1697 1
a1697 1
          wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1701 2
d1705 1
a1705 1
        for (jhat = 0; jhat < Nhat; jhat++) {
d1712 1
a1712 1
          wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1718 1
a1718 1
        for (jhat = 0; jhat < Nhat; jhat++) {
d1725 1
a1725 1
          wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1731 1
a1731 1
          wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1735 1
a1735 1
          wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1746 1
d1751 1
a1751 1
            for (idp = 0; idp < 6; idp++) {
d1768 1
a1768 1
              wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1777 1
a1777 1
          for (idp = 0; idp < iparm[I_TPDNCO]; idp++) {
d1786 1
a1786 1
            m = idp;
d1791 1
a1791 1
            wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1801 1
a1801 1
            wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1808 2
a1809 2
          wcshdo_util(ctrl, "", "", 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
            nkeyrec, header, &status);
d1813 1
a1813 1
          for (idp = iparm[I_TPDNCO]; idp < iparm[I_NDPARM]; idp++) {
d1817 1
a1817 1
            m = idp - iparm[I_TPDNCO];
d1822 1
a1822 1
            wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1831 3
a1833 3
          keyp = dis->dp;
          for (idp = 0; idp < dis->ndp; idp++, keyp++) {
            if (keyp->j != j+1) continue;
d1835 1
a1835 1
            cp = strchr(keyp->field, '.') + 1;
d1838 2
a1839 2
            sprintf(keyvalue, "'%s: %d'", cp, dpkeyi(keyp));
            wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1843 3
a1845 3
            keyp = dis->dp;
            for (idp = 0; idp < dis->ndp; idp++, keyp++) {
              if (keyp->j != j+1) continue;
d1847 1
a1847 1
              keyval = dpkeyd(keyp);
d1849 1
a1849 1
              cp = strchr(keyp->field, '.') + 1;
d1852 1
d1857 1
a1857 1
              kp = keyvalue + strlen(keyvalue);
d1868 1
d1884 1
a1884 1
              wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1892 3
a1894 3
          keyp = dis->dp;
          for (idp = 0; idp < dis->ndp; idp++, keyp++) {
            if (keyp->j != j+1) continue;
d1896 1
a1896 1
            cp = strchr(keyp->field, '.') + 1;
d1899 2
a1900 2
            sprintf(keyvalue, "'%s: %d'", cp, dpkeyi(keyp));
            wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1905 3
a1907 3
          keyp = dis->dp;
          for (idp = 0; idp < dis->ndp; idp++, keyp++) {
            if (keyp->j != j+1) continue;
d1909 1
a1909 1
            if ((keyval = dpkeyd(keyp)) == 0.0) continue;
d1911 1
a1911 1
            cp = strchr(keyp->field, '.') + 1;
d1914 1
d1919 1
a1919 1
            kp = keyvalue + strlen(keyvalue);
d1927 1
d1941 1
a1941 1
            wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1951 1
a1951 1
            wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1962 1
a1962 1
      wcshdo_util(ctrl, "DVERR", "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1969 2
a1970 2
  wcshdo_util(ctrl, "", "", 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
    nkeyrec, header, &status);
d1981 1
a1981 1
  wcshdo_util(ctrl, "COMMENT", "", 0, 0x0, 0, 0, 0, ' ', 0, 0,
d2066 1
a2066 2
  int degree, k;

d2075 1
a2075 1
    k = degree - (m - nTPD[degree-1]);
a2112 3
  char ch0, ch1, *hptr, keyword[32], *kptr;
  int  nbyte, nc = 47, nv;

d2116 1
d2118 1
a2118 1
    nbyte = ((*nkeyrec)/32 + 1) * 2880;
d2128 1
d2216 1
a2216 1
        kptr = hptr++;
d2218 1
a2218 1
          ch0 = *kptr;
d2220 1
a2220 1
            ch1 = *(++kptr);
d2247 1
@


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


8.1.1.2
log
@In wcshdo(), pass the pikey and tbkey arguments of wcshdo_util()
consistently as null pointers (0x0) in place of null strings ("").
@
text
@d22 1
a22 1
  $Id: wcshdr.c,v 8.1.1.1 2023/07/05 17:15:00 mcalabre Exp mcalabre $
d1185 1
a1185 1
    wcshdo_util(ctrl, "TSTOP", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
d1193 1
a1193 1
    wcshdo_util(ctrl, "XPOSURE", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
d1201 1
a1201 1
    wcshdo_util(ctrl, "TELAPSE", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
d1211 1
a1211 1
    wcshdo_util(ctrl, "TIMSYER", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
d1219 1
a1219 1
    wcshdo_util(ctrl, "TIMRDER", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
d1227 1
a1227 1
    wcshdo_util(ctrl, "TIMEDEL", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
d1234 1
a1234 1
    wcshdo_util(ctrl, "TIMEPIXR", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
d1457 1
a1457 1
      wcshdo_util(ctrl, 0x0, 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
d1474 1
a1474 1
      wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0,
d1493 1
a1493 1
        wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0,
d1500 1
a1500 1
        wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0,
d1508 1
a1508 1
      wcshdo_util(ctrl, 0x0, 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
d1525 1
a1525 1
      wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0,
d1544 1
a1544 1
        wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0,
d1570 1
a1570 1
        wcshdo_util(ctrl, 0x0, 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
d1596 1
a1596 1
          wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0,
d1604 1
a1604 1
        wcshdo_util(ctrl, 0x0, 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
d1651 1
a1651 1
        wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0,
d1664 1
a1664 1
        wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0,
d1691 1
a1691 1
          wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0,
d1704 1
a1704 1
          wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0,
d1717 1
a1717 1
          wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0,
d1723 1
a1723 1
          wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0,
d1727 1
a1727 1
          wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0,
d1759 1
a1759 1
              wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0,
d1782 1
a1782 1
            wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0,
d1792 1
a1792 1
            wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0,
d1799 1
a1799 1
          wcshdo_util(ctrl, 0x0, 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
d1813 1
a1813 1
            wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0,
d1830 1
a1830 1
            wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0,
d1873 1
a1873 1
              wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0,
d1889 1
a1889 1
            wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0,
d1928 1
a1928 1
            wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0,
d1938 1
a1938 1
            wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0,
d1949 1
a1949 1
      wcshdo_util(ctrl, "DVERR", 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0,
d1956 1
a1956 1
  wcshdo_util(ctrl, 0x0, 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
d1968 1
a1968 1
  wcshdo_util(ctrl, "COMMENT", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0,
@


8.1.1.3
log
@In wcshdo(), fixed character buffer overflows by increasing the size of
the comment[] and obsgeo[] arrays.  Also fixed formatting of the comment
for longitude and latitude axes.
@
text
@d504 1
a504 1
  char alt, comment[128], ctemp[32], *ctypei, format[16], fmt01[8],
d506 1
a506 1
       obsgeo[16] = "OBSGEO-?", pq, ptype, xtype, term[16], timeunit[16],
d777 1
a777 1
            strcpy(comment, "Galactic l");
d780 1
a780 1
            strcpy(comment, "Ecliptic l");
d783 1
a783 1
            strcpy(comment, "Helioecliptic l");
d786 1
a786 5
            strcpy(comment, "Supergalactic l");
            break;
          default:
	    // User-defined coordinate system.
            strcpy(comment, "L");
d791 1
a791 1
            strcat(comment, "ongitude, ");
d793 1
a793 1
            strcat(comment, "atitude, ");
@


8.1.1.4
log
@Moved variable declarations closer to where the variable are used in all
functions, in the process fixing a bug in wcstab() at line 210 relating to
variable i, and in wcshdo() at line 1841 relating to variable keyp.
@
text
@d22 1
a22 1
  $Id: wcshdr.c,v 8.1.1.2 2023/11/14 06:06:05 mcalabre Exp mcalabre $
a79 1
  // Pointers to allocated memory.
d81 5
a85 4
  int  *PVi_1a = 0x0, *PVi_2a = 0x0, *PVi_3a = 0x0;
  int  *tabidx = 0x0;

  int status = 0;
d88 1
a88 1
  struct wcserr **err = &(wcs->err);
d97 1
a97 1
      for (int j = 0; j < wcs->ntab; j++) {
d112 1
a112 2
  int naxis = wcs->naxis;
  int *tabax;
d117 2
a118 2
  int ntabax = 0;
  for (int i = 0; i < naxis; i++) {
d131 1
d148 1
a148 1
  for (int itabax = 0; itabax < ntabax; itabax++) {
d155 2
a156 2
  for (int ip = 0; ip < wcs->nps; ip++) {
    int itabax = tabax[wcs->ps[ip].i - 1];
d178 2
a179 2
  for (int ip = 0; ip < wcs->npv; ip++) {
    int itabax = tabax[wcs->pv[ip].i - 1];
d200 1
a200 1
  for (int itabax = 0; itabax < ntabax; itabax++) {
d209 1
a209 2
    int jtabax;
    for (jtabax = 0; jtabax < itabax; jtabax++) {
d234 2
a235 2
  for (int itabax = 0; itabax < ntabax; itabax++) {
    struct tabprm *tabp = wcs->tab + tabidx[itabax];
d243 1
a243 1
  for (int itab = 0; itab < wcs->ntab; itab++) {
d252 1
a252 2
  for (int i = 0; i < naxis; i++) {
    int itabax;
d259 1
a259 1
    int m = PVi_3a[itabax] - 1;
a260 1
    struct tabprm *tabp;
d267 2
a268 2
  for (int itab = 0; itab < wcs->ntab; itab++) {
    for (int m = 0; m < wcs->tab[itab].M; m++) {
d279 1
a279 1
  for (int itabax = 0; itabax < ntabax; itabax++) {
d299 4
a302 4
  struct wtbarr *wtbp = wcs->wtb;
  for (int itab = 0; itab < wcs->ntab; itab++) {
    int getcrd = 1;
    for (int itabax = 0; itabax < ntabax; itabax++) {
d333 1
a333 1
        int m = wtbp->m - 1;
d351 2
d376 4
a379 1
  for (int a = 0; a < 27; a++) {
d387 2
a388 2
  struct wcsprm *wcsp = *wcs;
  for (int iwcs = 0; iwcs < nwcs; iwcs++, wcsp++) {
a390 1
    int a;
d408 5
a412 1
  for (short *ip = alts[0]; ip < alts[0] + 28*1000; ip++) {
d416 1
a416 1
  for (int icol = 0; icol < 1000; icol++) {
d424 2
a425 3
  struct wcsprm *wcsp = *wcs;
  for (int iwcs = 0; iwcs < nwcs; iwcs++, wcsp++) {
    int a;
d435 1
a435 1
        for (int i = 0; i < wcsp->naxis; i++) {
d464 2
a465 1
  int status = 0;
d471 2
a472 2
  struct wcsprm *wcsp = *wcs;
  for (int a = 0; a < *nwcs; a++, wcsp++) {
d504 12
a515 2
  char comment[128], keyvalue[96], keyword[16];
  int  status = 0;
d521 1
a521 1
  struct wcserr **err = &(wcs->err);
a526 1
  int naxis;
d533 1
a533 1
  char alt = wcs->alt[0];
d535 2
a536 2
  int colnum = wcs->colnum;
  int *colax = wcs->colax;
d538 3
a540 3
  int primage = 0;
  int bintab  = 0;
  int pixlist = 0;
a550 1
  char format[16];
d574 1
a574 1
  int dofmt = (*format == '\0');
d586 1
a586 1
  for (int j = 0; j < naxis; j++) {
d595 3
a597 3
  int k = 0;
  for (int i = 0; i < naxis; i++) {
    for (int j = 0; j < naxis; j++, k++) {
d614 1
a614 1
  for (int i = 0; i < naxis; i++) {
d624 1
a624 1
  for (int i = 0; i < naxis; i++) {
d636 3
a638 3
  char   tpdsrc[24];
  int    dosip = 0, dotpd = 0, dotpv = 0;
  struct disprm *dis;
d641 1
a641 1
    for (int i = 0; i < naxis; i++) {
d686 1
a686 1
    for (int i = 0; i < naxis; i++) {
d741 1
a741 1
  for (int i = 0; i < naxis; i++) {
d747 1
a747 1
    char *ctypei = keyvalue + 1;
d789 1
a789 1
            // User-defined coordinate system.
a805 1
      char ptype, xtype;
d829 1
a829 1
  for (int i = 0; i < naxis; i++) {
d841 1
a841 1
  for (int k = 0; k < wcs->npv; k++) {
d883 1
a883 1
  for (int k = 0; k < wcs->nps; k++) {
a920 1
  char timeunit[16];
d925 1
a925 1
    for (int i = 0; i < naxis; i++) {
d937 1
a937 1
    for (int i = 0; i < naxis; i++) {
d951 1
a951 1
    for (int i = 0; i < naxis; i++) {
d965 1
a965 1
    for (int i = 0; i < naxis; i++) {
d977 1
a977 1
    for (int i = 0; i < naxis; i++) {
d1250 1
a1250 2
    char obsgeo[16] = "OBSGEO-?", obsg[8] = "OBSG?", xyz[] = "XYZ";
    for (int k = 0; k < 3; k++) {
a1345 1
  struct auxprm *aux;
a1432 3
  char term[16];
  double *dparm, keyval;

d1440 4
a1443 4
      struct dpkey *ikeyp = dis->dp;
      int kp0 = 2;
      for (int idp = 0; idp < dis->ndp; idp++, ikeyp++) {
        cp = strchr(ikeyp->field, '.') + 1;
d1445 1
a1445 1
        wcsutil_double2str(keyvalue, "%20.13E", dpkeyd(ikeyp));
d1447 1
a1447 1
        int kpi = 15;
d1452 1
a1452 1
      int precision = kp0 - 2;
d1459 1
a1459 1
    for (int j = 0; j <= 1; j++) {
d1470 1
a1470 2
      int degree;
      int ncoeff = dis->iparm[j][I_TPDNCO];
d1481 4
a1484 4
      struct dpkey *ikeyp = dis->dp;
      for (int idp = 0; idp < dis->ndp; idp++, ikeyp++) {
        if (ikeyp->j != j+1) continue;
        if ((keyval = dpkeyd(ikeyp)) == 0.0) continue;
d1486 1
a1486 1
        cp = strchr(ikeyp->field, '.') + 1;
a1489 1
        int p, q;
d1532 4
a1535 4
      ikeyp = dis->dp;
      for (int idp = 0; idp < dis->ndp; idp++, ikeyp++) {
        if (ikeyp->j != j+1) continue;
        if ((keyval = dpkeyd(ikeyp)) == 0.0) continue;
d1537 1
a1537 1
        cp = strchr(ikeyp->field, '.') + 1;
a1540 1
        int p, q;
d1554 1
a1554 1
  for (int idis = 0; idis < 2; idis++) {
d1558 1
a1558 1
    for (int j = 0; j < naxis; j++) {
d1561 1
a1561 1
      int *iparm = dis->iparm[j];
a1571 1
        char fmt01[8];
d1579 1
a1579 1
        char *kp = keyword + strlen(keyword);
d1581 4
a1584 4
        struct dpkey *ikeyp = dis->dp;
        for (int idp = 0; idp < dis->ndp; idp++, ikeyp++) {
          if (ikeyp->j != j+1) continue;
          if ((keyval = dpkeyd(ikeyp)) == 0.0) continue;
d1586 1
a1586 1
          cp = strchr(ikeyp->field, '.') + 1;
a1590 1
          int m;
d1620 2
a1621 2
        char pq = idis ? 'Q' : 'P';
        int Nhat = dis->Nhat[j];
a1630 1
        int direct = 0, doaux;
d1636 1
a1636 1
          int *axmap = dis->axmap[j];
d1672 2
a1673 2
        for (int jhat = 0; jhat < Nhat; jhat++) {
          int *axmap = dis->axmap[j];
a1698 2
        char ctemp[32];

d1701 1
a1701 1
        for (int jhat = 0; jhat < Nhat; jhat++) {
d1714 1
a1714 1
        for (int jhat = 0; jhat < Nhat; jhat++) {
a1741 1
          char fmt01[8];
d1746 1
a1746 1
            for (int idp = 0; idp < 6; idp++) {
d1772 1
a1772 1
          for (int idp = 0; idp < iparm[I_TPDNCO]; idp++) {
d1781 1
a1781 1
            int m = idp;
d1808 1
a1808 1
          for (int idp = iparm[I_TPDNCO]; idp < iparm[I_NDPARM]; idp++) {
d1812 1
a1812 1
            int m = idp - iparm[I_TPDNCO];
d1826 3
a1828 3
          struct dpkey *ikeyp = dis->dp;
          for (int idp = 0; idp < dis->ndp; idp++, ikeyp++) {
            if (ikeyp->j != j+1) continue;
d1830 1
a1830 1
            cp = strchr(ikeyp->field, '.') + 1;
d1833 1
a1833 1
            sprintf(keyvalue, "'%s: %d'", cp, dpkeyi(ikeyp));
d1838 3
a1840 3
            struct dpkey *jkeyp = dis->dp;
            for (int jdp = 0; jdp < dis->ndp; jdp++, jkeyp++) {
              if (jkeyp->j != j+1) continue;
d1842 1
a1842 1
              keyval = dpkeyd(jkeyp);
d1844 1
a1844 1
              cp = strchr(jkeyp->field, '.') + 1;
a1846 1
              int m;
d1851 1
a1851 1
              char *kp = keyvalue + strlen(keyvalue);
a1861 1
              int p;
d1885 3
a1887 3
          ikeyp = dis->dp;
          for (int idp = 0; idp < dis->ndp; idp++, ikeyp++) {
            if (ikeyp->j != j+1) continue;
d1889 1
a1889 1
            cp = strchr(ikeyp->field, '.') + 1;
d1892 1
a1892 1
            sprintf(keyvalue, "'%s: %d'", cp, dpkeyi(ikeyp));
d1898 3
a1900 3
          ikeyp = dis->dp;
          for (int idp = 0; idp < dis->ndp; idp++, ikeyp++) {
            if (ikeyp->j != j+1) continue;
d1902 1
a1902 1
            if ((keyval = dpkeyd(ikeyp)) == 0.0) continue;
d1904 1
a1904 1
            cp = strchr(ikeyp->field, '.') + 1;
a1906 1
            int m;
d1911 1
a1911 1
            char *kp = keyvalue + strlen(keyvalue);
a1918 1
              int p;
d2057 2
a2058 1
  int degree;
d2067 1
a2067 1
    int k = degree - (m - nTPD[degree-1]);
d2105 3
a2110 1
  char *hptr;
d2112 1
a2112 1
    int nbyte = ((*nkeyrec)/32 + 1) * 2880;
a2121 1
  char keyword[32];
d2209 1
a2209 1
        char *kptr = hptr++;
d2211 1
a2211 1
          char ch0 = *kptr;
d2213 1
a2213 1
            char ch1 = *(++kptr);
a2239 1
  int nc = 47, nv;
@


8.1.1.5
log
@Revised the change made at 8.1.1.2, only the tbkey argument may be specified
as a null pointer, and only when btcol == 0 && plcol == 0x0.
@
text
@d22 1
a22 1
  $Id: wcshdr.c,v 8.1.1.4 2023/11/14 12:39:25 mcalabre Exp mcalabre $
d867 2
a868 2
      wcs->pv[k].m, alt, colnum, colax, keyvalue, comment, nkeyrec, header,
      &status);
d875 2
a876 1
      "Coordinate transformation parameter", nkeyrec, header, &status);
d882 3
a884 3
    wcshdo_util(ctrl, "LONPOLE", "LONP", 0, 0x0, 0, 0, 0, alt, colnum, colax,
      keyvalue, "[deg] Native longitude of celestial pole", nkeyrec, header,
      &status);
d889 3
a891 3
    wcshdo_util(ctrl, "LATPOLE", "LATP", 0, 0x0, 0, 0, 0, alt, colnum, colax,
      keyvalue, "[deg] Native latitude of celestial pole", nkeyrec, header,
      &status);
d896 3
a898 2
    wcshdo_util(ctrl, "RESTFRQ", "RFRQ", 0, 0x0, 0, 0, 0, alt, colnum, colax,
      keyvalue, "[Hz] Line rest frequency", nkeyrec, header, &status);
d903 3
a905 2
    wcshdo_util(ctrl, "RESTWAV", "RWAV", 0, 0x0, 0, 0, 0, alt, colnum, colax,
      keyvalue, "[Hz] Line rest wavelength", nkeyrec, header, &status);
d982 3
a984 2
      wcshdo_util(ctrl, "WCSNAME", "WCSN", 0, 0x0, 0, 0, 0, alt, colnum,
        colax, keyvalue, "Coordinate system title", nkeyrec, header, &status);
d998 2
a999 2
    wcshdo_util(ctrl, "TIMESYS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "Time scale", nkeyrec, header, &status);
d1005 2
a1006 2
    wcshdo_util(ctrl, "TREFPOS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "Time reference position", nkeyrec, header, &status);
d1012 2
a1013 2
    wcshdo_util(ctrl, "TREFDIR", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "Time reference direction", nkeyrec, header, &status);
d1019 2
a1020 3
    wcshdo_util(ctrl, "PLEPHEM", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "Ephemerides used for pathlength delays", nkeyrec, header,
      &status);
d1026 2
a1027 2
    wcshdo_util(ctrl, "TIMEUNIT", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "Time units", nkeyrec, header, &status);
d1034 2
a1035 2
    wcshdo_util(ctrl, "MJDREF", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "[d] MJD of fiducial time", nkeyrec, header, &status);
d1076 2
a1077 2
    wcshdo_util(ctrl, "TIMEOFFS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, comment, nkeyrec, header, &status);
d1093 2
a1094 2
      wcshdo_util(ctrl, "DATE-OBS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        keyvalue, comment, nkeyrec, header, &status);
d1101 3
a1103 2
    wcshdo_util(ctrl, "MJD-OBS", "MJDOB", 0, 0x0, 0, 0, 0, ' ', colnum, colax,
      keyvalue, "[d] MJD of observation", nkeyrec, header, &status);
d1109 2
a1110 2
    wcshdo_util(ctrl, "JEPOCH", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "[a] Julian epoch of observation", nkeyrec, header, &status);
d1116 2
a1117 3
    wcshdo_util(ctrl, "BEPOCH", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "[a] Besselian epoch of observation", nkeyrec, header,
      &status);
d1123 2
a1124 3
    wcshdo_util(ctrl, "DATE-BEG", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "ISO-8601 time at start of observation", nkeyrec, header,
      &status);
d1130 2
a1131 2
    wcshdo_util(ctrl, "MJD-BEG", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "[d] MJD at start of observation", nkeyrec, header, &status);
d1139 2
a1140 2
    wcshdo_util(ctrl, "TSTART", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, comment, nkeyrec, header, &status);
d1146 3
a1148 3
    wcshdo_util(ctrl, "DATE-AVG", "DAVG", 0, 0x0, 0, 0, 0, ' ', colnum, colax,
      keyvalue, "ISO-8601 time at midpoint of observation", nkeyrec, header,
      &status);
d1154 3
a1156 3
    wcshdo_util(ctrl, "MJD-AVG", "MJDA", 0, 0x0, 0, 0, 0, ' ', colnum, colax,
      keyvalue, "[d] MJD at midpoint of observation", nkeyrec, header,
      &status);
d1162 2
a1163 3
    wcshdo_util(ctrl, "DATE-END", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "ISO-8601 time at end of observation", nkeyrec, header,
      &status);
d1169 2
a1170 2
    wcshdo_util(ctrl, "MJD-END", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "[d] MJD at end of observation", nkeyrec, header, &status);
d1178 2
a1179 2
    wcshdo_util(ctrl, "TSTOP", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, comment, nkeyrec, header, &status);
d1186 2
a1187 2
    wcshdo_util(ctrl, "XPOSURE", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, comment, nkeyrec, header, &status);
d1194 2
a1195 2
    wcshdo_util(ctrl, "TELAPSE", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, comment, nkeyrec, header, &status);
d1204 2
a1205 2
    wcshdo_util(ctrl, "TIMSYER", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, comment, nkeyrec, header, &status);
d1212 2
a1213 2
    wcshdo_util(ctrl, "TIMRDER", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, comment, nkeyrec, header, &status);
d1220 2
a1221 2
    wcshdo_util(ctrl, "TIMEDEL", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, comment, nkeyrec, header, &status);
d1227 3
a1229 3
    wcshdo_util(ctrl, "TIMEPIXR", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "Reference position of timestamp in binned data", nkeyrec,
      header, &status);
d1245 2
a1246 2
      wcshdo_util(ctrl, obsgeo, obsg, 0, 0x0, 0, 0, 0, ' ', colnum, colax,
        keyvalue, comment, nkeyrec, header, &status);
d1255 2
a1256 3
    wcshdo_util(ctrl, "OBSGEO-L", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "[deg] IAU(1976) observatory longitude", nkeyrec, header,
      &status);
d1259 2
a1260 3
    wcshdo_util(ctrl, "OBSGEO-B", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "[deg] IAU(1976) observatory latitude", nkeyrec, header,
      &status);
d1263 2
a1264 3
    wcshdo_util(ctrl, "OBSGEO-L", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "[m]   IAU(1976) observatory height", nkeyrec, header,
      &status);
d1270 2
a1271 2
    wcshdo_util(ctrl, "OBSORBIT", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
      keyvalue, "Spacecraft orbit ephemeris file", nkeyrec, header, &status);
d1455 2
a1456 2
      wcshdo_util(ctrl, "", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        "", "", nkeyrec, header, &status);
d1473 1
a1473 1
      wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
d1493 1
a1493 1
        wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
d1500 1
a1500 1
        wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
d1508 2
a1509 2
      wcshdo_util(ctrl, "", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        "", "", nkeyrec, header, &status);
d1525 1
a1525 1
      wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
d1545 1
a1545 1
        wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
d1572 2
a1573 2
        wcshdo_util(ctrl, "", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
          "", "", nkeyrec, header, &status);
d1599 1
a1599 1
          wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
d1607 2
a1608 2
        wcshdo_util(ctrl, "", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
          "", "", nkeyrec, header, &status);
d1655 1
a1655 1
        wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
d1668 1
a1668 1
        wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
d1695 1
a1695 1
          wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
d1710 1
a1710 1
          wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
d1723 1
a1723 1
          wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
d1729 1
a1729 1
          wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
d1733 1
a1733 1
          wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
d1766 1
a1766 1
              wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
d1789 1
a1789 1
            wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
d1799 1
a1799 1
            wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
d1806 2
a1807 2
          wcshdo_util(ctrl, "", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
            "", "", nkeyrec, header, &status);
d1820 1
a1820 1
            wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
d1837 1
a1837 1
            wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
d1882 1
a1882 1
              wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
d1898 1
a1898 1
            wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
d1939 1
a1939 1
            wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
d1949 1
a1949 1
            wcshdo_util(ctrl, keyword, 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
d1960 1
a1960 1
      wcshdo_util(ctrl, "DVERR", 0x0, 0, 0x0, 0, 0, 0, alt, 0, 0x0,
d1967 2
a1968 2
  wcshdo_util(ctrl, "", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
    "", "", nkeyrec, header, &status);
d1979 1
a1979 1
  wcshdo_util(ctrl, "COMMENT", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
@


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: wcshdr.c,v 7.13.1.4 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: wcshdr.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: wcshdr.c,v 7.12.1.1 2022/09/09 05:00:36 mcalabre Exp mcalabre $
d1382 42
@


7.13.1.1
log
@WCSLIB 7.13 development branch.
@
text
@d22 1
a22 1
  $Id: wcshdr.c,v 7.13 2022/10/07 03:43:35 mcalabre Exp $
@


7.13.1.2
log
@Support planetary keywords A_RADIUS, B_RADIUS, C_RADIUS, PLON_OBS, PLAT_OBS,
and PDIS_OBS in auxprm.
@
text
@d22 1
a22 1
  $Id: wcshdr.c,v 7.13.1.1 2022/10/07 03:45:47 mcalabre Exp mcalabre $
a1381 42
    }

    if (!undefined(aux->a_radius)) {
      wcsutil_double2str(keyvalue, format, aux->a_radius);
      wcshdo_util(ctrl, "A_RADIUS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        keyvalue, "[m] Object ellipsoid semi-major axis", nkeyrec,
        header, &status);
    }

    if (!undefined(aux->b_radius)) {
      wcsutil_double2str(keyvalue, format, aux->b_radius);
      wcshdo_util(ctrl, "B_RADIUS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        keyvalue, "[m] Object ellipsoid semi-intermediate axis", nkeyrec,
        header, &status);
    }

    if (!undefined(aux->c_radius)) {
      wcsutil_double2str(keyvalue, format, aux->c_radius);
      wcshdo_util(ctrl, "C_RADIUS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        keyvalue, "[m] Object ellipsoid semi-minor axis", nkeyrec,
        header, &status);
    }

    if (!undefined(aux->plon_obs)) {
      wcsutil_double2str(keyvalue, format, aux->plon_obs);
      wcshdo_util(ctrl, "PLON_OBS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        keyvalue, "[deg] Planetocentric longitude of observer", nkeyrec,
        header, &status);
    }

    if (!undefined(aux->plat_obs)) {
      wcsutil_double2str(keyvalue, format, aux->plat_obs);
      wcshdo_util(ctrl, "PLAT_OBS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        keyvalue, "[deg] Planetocentric latitude of observer", nkeyrec,
        header, &status);
    }

    if (!undefined(aux->pdis_obs)) {
      wcsutil_double2str(keyvalue, format, aux->pdis_obs);
      wcshdo_util(ctrl, "PDIS_OBS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        keyvalue, "[m] Planetocentric distance of observer", nkeyrec,
        header, &status);
@


7.13.1.3
log
@(PLON_OBS, PLAT_OBS, PDIS_OBS) -> (BLON_OBS, BLAT_OBS, BDIS_OBS).
@
text
@d22 1
a22 1
  $Id: wcshdr.c,v 7.13.1.2 2023/06/03 08:24:14 mcalabre Exp mcalabre $
d1405 4
a1408 4
    if (!undefined(aux->blon_obs)) {
      wcsutil_double2str(keyvalue, format, aux->blon_obs);
      wcshdo_util(ctrl, "BLON_OBS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        keyvalue, "[deg] Bodycentric longitude of observer", nkeyrec,
d1412 4
a1415 4
    if (!undefined(aux->blat_obs)) {
      wcsutil_double2str(keyvalue, format, aux->blat_obs);
      wcshdo_util(ctrl, "BLAT_OBS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        keyvalue, "[deg] Bodycentric latitude of observer", nkeyrec,
d1419 4
a1422 4
    if (!undefined(aux->bdis_obs)) {
      wcsutil_double2str(keyvalue, format, aux->bdis_obs);
      wcshdo_util(ctrl, "BDIS_OBS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        keyvalue, "[m] Bodycentric distance of observer", nkeyrec,
@


7.13.1.4
log
@Updated date in copyright notice.
@
text
@d3 1
a3 1
  Copyright (C) 1995-2023, Mark Calabretta
d22 1
a22 1
  $Id: wcshdr.c,v 7.13.1.3 2023/06/15 03:58:10 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: wcshdr.c,v 7.11.1.1 2022/04/26 06:15:32 mcalabre Exp mcalabre $
@


7.12.1.1
log
@WCSLIB 7.12 development branch.
@
text
@d22 1
a22 1
  $Id: wcshdr.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: wcshdr.c,v 7.10.1.1 2022/04/23 14:26:54 mcalabre Exp mcalabre $
@


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


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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.c,v 7.5.1.1 2021/03/20 05:56:42 mcalabre Exp mcalabre $
@


7.6.1.1
log
@WCSLIB 7.6 development branch.
@
text
@d22 1
a22 1
  $Id: wcshdr.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: wcshdr.c,v 7.4.1.1 2021/01/31 02:26:24 mcalabre Exp mcalabre $
@


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


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: wcshdr.c,v 7.3.1.6 2021/01/29 09:26:26 mcalabre Exp mcalabre $
@


7.4.1.1
log
@WCSLIB 7.4 development branch.
@
text
@d22 1
a22 1
  $Id: wcshdr.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: wcshdr.c,v 7.2.1.3 2020/05/30 11:51:47 mcalabre Exp mcalabre $
d44 1
a44 1
/* Map status return value to message. */
d53 1
a53 1
/* Map error returns for lower-level routines. */
d55 6
a60 6
  WCSHDRERR_SUCCESS,		/*  0: TABERR_SUCCESS         */
  WCSHDRERR_NULL_POINTER,	/*  1: TABERR_NULL_POINTER    */
  WCSHDRERR_MEMORY,		/*  2: TABERR_MEMORY          */
  WCSHDRERR_BAD_TABULAR_PARAMS	/*  3: TABERR_BAD_PARAMS      */
				/*  4: TABERR_BAD_X           */
				/*  5: TABERR_BAD_WORLD       */
d63 1
a63 1
/* Convenience macro for invoking wcserr_set(). */
d66 1
a66 1
/* Internal helper functions, not for general use. */
d73 1
a73 1
/*--------------------------------------------------------------------------*/
d90 1
a90 1
  /* Free memory previously allocated by wcstab(). */
d111 1
a111 1
  /* Determine the number of -TAB axes. */
d119 1
a119 1
    /* Null fill. */
d130 1
a130 1
    /* No lookup tables. */
d136 1
a136 1
  /* Collect information from the PSi_ma and PVi_ma keyvalues. */
d149 1
a149 1
    /* Remember that calloc() zeroes allocated memory. */
d160 1
a160 1
        /* EXTNAME. */
d165 1
a165 1
        /* TTYPEn for coordinate array. */
d170 1
a170 1
        /* TTYPEn for index vector. */
d183 1
a183 1
        /* EXTVER. */
d187 1
a187 1
        /* EXTLEVEL. */
d191 1
a191 1
        /* Table axis number. */
d199 1
a199 1
  /* Determine the number of independent tables. */
d201 1
a201 1
    /* These have no defaults. */
d210 2
a211 2
      /* EXTNAME, EXTVER, EXTLEVEL, and TTYPEn for the coordinate array */
      /* must match for each axis of a multi-dimensional lookup table.  */
d233 1
a233 1
  /* Table dimensionality; find the largest axis number. */
d237 1
a237 1
    /* PVi_3a records the 1-relative table axis number. */
d251 1
a251 1
  /* Copy parameters into the tabprm structs. */
d254 1
a254 1
      /* Not a -TAB axis. */
d258 1
a258 1
    /* PVi_3a records the 1-relative table axis number. */
d266 1
a266 1
  /* Check for completeness. */
d278 1
a278 1
  /* Set up for reading the arrays; how many arrays are there? */
d280 1
a280 1
    /* Does this -TAB axis have a non-degenerate index array? */
d286 1
a286 1
  /* Add one coordinate array for each table. */
d289 1
a289 1
  /* Allocate memory for structs to be returned. */
d298 1
a298 1
  /* Set pointers for the index and coordinate arrays. */
d306 1
a306 1
        /* Coordinate array. */
d320 1
a320 1
        /* Signal for tabset() to take this memory. */
d328 1
a328 1
        /* Index array. */
d343 1
a343 1
        /* Signal for tabset() to take this memory. */
d371 1
a371 1
/*--------------------------------------------------------------------------*/
d403 1
a403 1
/*--------------------------------------------------------------------------*/
d433 1
a433 1
      /* Pixel list. */
d445 1
a445 1
      /* Binary table image array. */
d459 1
a459 1
/*--------------------------------------------------------------------------*/
d484 9
a492 9
/*--------------------------------------------------------------------------*/
#define I_DTYPE   0	/* Distortion type code.                            */
#define I_NIPARM  1	/* Full (allocated) length of iparm[].              */
#define I_NDPARM  2	/* No. of parameters in dparm[], excl. work space.  */
#define I_DOCORR  3	/* True if distortion func computes a correction.   */
#define I_TPDNCO  4	/* No. of TPD coefficients, forward...              */
#define I_TPDINV  5	/* ...and inverse.                                  */
#define I_TPDAUX  6	/* True if auxiliary variables are used.            */
#define I_TPDRAD  7	/* True if the radial variable is used.             */
d496 1
a496 1
/* ::: CUBEFACE and STOKES handling? */
d532 1
a532 1
  /* These are mainly for convenience. */
d550 1
a550 1
  /* Initialize floating point format control. */
d577 1
a577 1
  /* WCS dimension. */
d584 1
a584 1
  /* Reference pixel coordinates. */
d593 1
a593 1
  /* Linear transformation matrix. */
d612 1
a612 1
  /* Coordinate increment at reference point. */
d623 1
a623 1
  /* Units of coordinate increment and reference value. */
d633 3
a635 3
  /* May need to alter ctype for particular distortions so do basic checks */
  /* now.  Note that SIP, TPV, DSS, TNX, and ZPX are restricted to exactly */
  /* two axes and cannot coexist with other distortion types.              */
d643 2
a644 2
        /* Simple Imaging Polynomial (SIP).  Write it in its native form  */
        /* if possible, unless specifically requested to write it as TPD. */
d663 2
a664 2
            /* Must have been read as a 'SIP' distortion, CPDISja = 'SIP'. */
            /* Cannot be written as native SIP so write it as TPD.         */
d668 2
a669 2
            /* Must have been permuted by wcssub(). */
            /* Native SIP doesn't have axis mapping so write it as TPD. */
d688 2
a689 2
        /* TPV "projection".  Write it in its native form if possible, */
        /* unless specifically requested to write it as TPD.           */
d705 2
a706 2
            /* Must have been read as a 'TPV' distortion, CPDISja = 'TPV'. */
            /* Cannot be written as native TPV so write it as TPD.         */
d720 1
a720 1
        /* Always written as TPD. */
d725 1
a725 1
        /* Always written as TPD. */
d740 1
a740 1
  /* Coordinate type. */
d749 1
a749 1
      /* Alter ctype for particular distortions. */
d751 1
a751 1
        /* It could have come in as CPDISja = 'SIP'. */
d754 1
a754 1
        /* Reinstate projection code edited by wcsset(). */
d824 1
a824 1
  /* Coordinate value at reference point. */
d835 1
a835 1
  /* Parameter values. */
d887 1
a887 1
  /* Celestial and spectral transformation parameters. */
d916 1
a916 1
  /* - - - - - - - - - - - - - - - - Auxiliary coordinate axis information. */
d919 1
a919 1
  /* Coordinate axis title. */
d931 1
a931 1
  /* Random error in coordinate. */
d945 1
a945 1
  /* Systematic error in coordinate. */
d959 1
a959 1
  /* Time at zero point of phase axis. */
d971 1
a971 1
  /* Period of phase axis. */
d983 1
a983 1
  /* - - - - - - - - - - - - - - - - - - - - - -  Coordinate system title.  */
d985 1
a985 1
  /* Coordinate system title. */
d993 1
a993 1
      /* TWCS was a mistake. */
d1000 1
a1000 1
  /* - - - - - - - - - - - - - - - - Time reference system and measurement. */
d1002 1
a1002 1
  /* Time scale. */
d1009 1
a1009 1
  /* Time reference position. */
d1016 1
a1016 1
  /* Time reference direction. */
d1023 1
a1023 1
  /* Ephemerides used for pathlength delay calculation. */
d1030 1
a1030 1
  /* Time units. */
d1037 1
a1037 1
  /* Fiducial (reference) time. */
d1039 1
a1039 1
    /* MJD of fiducial time (simplified if it takes its default value). */
d1045 1
a1045 1
    /* ISO-8601 fiducial time. */
d1053 1
a1053 1
      /* MJD of fiducial time (no fractional part). */
d1061 1
a1061 1
      /* MJD of fiducial time, integer part. */
d1069 1
a1069 1
      /* MJD of fiducial time, fractional part. */
d1079 1
a1079 1
  /* Clock correction. */
d1087 1
a1087 1
  /* - - - - - - - - - - - - - - - - - - - - Data timestamps and durations. */
d1089 1
a1089 1
  /* ISO-8601 time of observation. */
d1095 1
a1095 1
      /* Allow DOBSn. */
d1099 1
a1099 1
      /* Force DATE-OBS. */
d1105 1
a1105 1
  /* MJD of observation. */
d1113 1
a1113 1
  /* Julian epoch of observation. */
d1120 1
a1120 1
  /* Besselian epoch of observation. */
d1127 1
a1127 1
  /* ISO-8601 time at start of observation. */
d1134 1
a1134 1
  /* MJD at start of observation. */
d1141 1
a1141 1
  /* Time elapsed at start since fiducial time. */
d1150 1
a1150 1
  /* ISO-8601 time at midpoint of observation. */
d1158 1
a1158 1
  /* MJD at midpoint of observation. */
d1166 1
a1166 1
  /* ISO-8601 time at end of observation. */
d1173 1
a1173 1
  /* MJD at end of observation. */
d1180 1
a1180 1
  /* Time elapsed at end since fiducial time. */
d1189 1
a1189 1
  /* Exposure (integration) time. */
d1197 1
a1197 1
  /* Elapsed time (start to stop). */
d1205 1
a1205 1
  /* - - - - - - - - - - - - - - - - - - - - - - - - - - - Timing accuracy. */
d1207 1
a1207 1
  /* Systematic error in time measurements. */
d1215 1
a1215 1
  /* Relative error in time measurements. */
d1223 1
a1223 1
  /* Time resolution. */
d1231 1
a1231 1
  /* Reference position of timestamp in binned data. */
d1239 1
a1239 1
  /* - - - - - - - - - - - - - - - - - Spatial & celestial reference frame. */
d1241 1
a1241 1
  /* Observatory coordinates. */
d1273 1
a1273 1
  /* Spacecraft orbit ephemeris file. */
d1280 1
a1280 1
  /* Equatorial coordinate system type. */
d1287 1
a1287 1
  /* Equinox of equatorial coordinate system. */
d1295 1
a1295 1
  /* Reference frame of spectral coordinates. */
d1303 1
a1303 1
  /* Reference frame of spectral observation. */
d1311 1
a1311 1
  /* Observer's velocity towards source. */
d1318 1
a1318 1
  /* Redshift of the source. */
d1325 1
a1325 1
  /* Reference frame of source redshift. */
d1333 1
a1333 1
  /* Velocity orientation angle. */
d1340 1
a1340 1
  /* - - - - - - - - - - - - - - - - - - - Additional auxiliary parameters. */
d1385 1
a1385 1
  /* - - - - - - - - - - - - - - - - - - - Distortion function parameters.  */
d1388 4
a1391 4
    /* Simple Imaging Polynomial (SIP) is handled by translating its dpkey */
    /* records.  Determine a suitable numerical precision for the          */
    /* polynomial coefficients to avoid trailing zeroes common to all of   */
    /* them.                                                               */
d1412 1
a1412 1
    /* Ensure the coefficients are written in a human-readable sequence. */
d1414 1
a1414 1
      /* Distortion function polynomial coefficients. */
d1463 1
a1463 1
      /* Inverse distortion function polynomial coefficients. */
d1518 1
a1518 1
      /* Identify the distortion type. */
d1520 5
a1524 5
        /* TPV "projection" is handled by translating its dpkey records, */
        /* which were originally translated from PVi_ma by wcsset(), or  */
        /* possibly input directly as a CQDISia = 'TPV' distortion type. */
        /* Determine a suitable numerical precision for the polynomial   */
        /* coefficients to avoid trailing zeroes common to all of them.  */
d1531 1
a1531 1
        /* Distortion function polynomial coefficients. */
d1544 1
a1544 1
          /* Identify the term of the TPV polynomial for human readers. */
d1561 1
a1561 1
        /* One of the Paper IV type polynomial distortions. */
d1566 1
a1566 1
          /* Pure TPD. */
d1569 1
a1569 1
          /* Polynomial distortion.  Write it as TPD by request? */
d1577 1
a1577 1
        /* CPDISja/CQDISia */
d1589 1
a1589 1
          /* For identifying terms of the TPD polynomial. */
d1594 1
a1594 1
            /* Associate x with longitude, y with latitude. */
d1600 1
a1600 1
              /* Non-celestial. */
d1612 1
a1612 1
        /* NAXES. */
d1625 1
a1625 1
        /* AXIS.jhat */
d1642 1
a1642 1
            /* axid is "xyxuvu". */
d1653 1
a1653 1
        /* OFFSET.jhat */
d1666 1
a1666 1
        /* SCALE.jhat */
d1679 2
a1680 2
        /* Does the distortion function compute a correction? */
        if (iparm[I_DOCORR]) {
d1684 4
d1691 4
a1694 4
          /* Template Polynomial Distortion (TPD).  As it may have been */
          /* translated from SIP, TPV, DSS, TNX, ZPX, or perhaps        */
          /* Polynomial, the dpkey records may not relate to TPD.       */
          /* Output is therefore handled via dparm.                     */
d1698 1
a1698 1
          /* AUX.jhat.COEFF.m */
d1725 1
a1725 1
          /* TPD.FWD.m */
d1744 1
a1744 1
          /* CPERRja/CQERRia */
d1754 1
a1754 1
          /* Inverse distortion function polynomial coefficients. */
d1760 1
a1760 1
          /* TPD.REV.m */
d1776 2
a1777 2
          /* General polynomial distortion, handled via its dpkey records */
          /* since iparm and dparm may hold a translation to TPD.         */
d1779 1
a1779 1
          /* Do auxiliary variables first. */
d1838 1
a1838 1
          /* Do polynomial terms. */
d1890 1
a1890 1
          /* CPERRja/CQERRia */
d1903 1
a1903 1
    /* DVERRa */
d1913 1
a1913 1
  /* Add identification. */
d1918 1
a1918 1
    /* TPD by translation. */
d1936 2
a1937 2
/*--------------------------------------------------------------------------*/
/* Determine a suitable floating point format for a set of parameters.      */
d1946 8
a1953 2
  char cval[24];
  int  cp0, cpi, i, expmax, expon, nsig, precision;
d1955 2
a1956 9
  if (fmt == 'G') {
    fmt = 'f';
    for (i = 0; i < nval; i++) {
      if (fabs(val[i]) < 1e-4 || 1e12 < val[i]) {
        fmt = 'E';
        break;
      }
    }
  }
d1958 3
a1960 6
  cp0 = 2;
  expmax = -999;
  for (i = 0; i < nval; i++) {
    /* Double precision has at least 15 significant digits, and up to 17:  */
    /* http://en.wikipedia.org/wiki/Double-precision_floating-point_format */
    wcsutil_double2str(cval, "%21.14E", val[i]);
d1962 3
a1964 3
    cpi = 16;
    while (cp0 < cpi && cval[cpi] == '0') cpi--;
    cp0 = cpi;
d1966 3
a1968 2
    sscanf(cval+18, "%d", &expon);
    if (expmax < expon) expmax = expon;
a1970 1
  nsig = cp0 - 1;
d1972 10
d1984 1
a1984 1
    precision = nsig - (expmax + 1);
a1989 1
    precision = nsig - 1;
d2000 2
a2001 2
/*--------------------------------------------------------------------------*/
/* Construct a string that identifies the term of a TPD or TPV polynomial.  */
d2037 2
a2038 2
/*--------------------------------------------------------------------------*/
/* Construct a keyrecord from the components given.                         */
d2064 1
a2064 1
  /* Reallocate memory in blocks of 2880 bytes. */
d2075 1
a2075 1
  /* Construct the keyword. */
d2078 1
a2078 1
    /* Binary table image array. */
d2094 1
a2094 1
      /* Use the long form. */
d2111 1
a2111 1
    /* Pixel list. */
d2127 1
a2127 1
      /* Use the long form. */
d2158 1
a2158 1
  /* Double-up single-quotes in string keyvalues. */
d2179 1
a2179 1
    /* Check length. */
d2181 1
a2181 1
      /* Truncate. */
d2187 1
a2187 1
    /* Check length. */
d2189 1
a2189 1
      /* Truncate. */
d2195 1
a2195 1
    /* Rob the keycomment to make space for the keyvalue. */
@


7.3.1.1
log
@WCSLIB 7.3 development branch.
@
text
@d25 1
a25 1
  $Id: wcshdr.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: wcshdr.c,v 7.3.1.1 2020/06/03 03:38:10 mcalabre Exp mcalabre $
d47 1
a47 1
// Map status return value to message.
d56 1
a56 1
// Map error returns for lower-level routines.
d58 6
a63 6
  WCSHDRERR_SUCCESS,		//  0: TABERR_SUCCESS
  WCSHDRERR_NULL_POINTER,	//  1: TABERR_NULL_POINTER
  WCSHDRERR_MEMORY,		//  2: TABERR_MEMORY
  WCSHDRERR_BAD_TABULAR_PARAMS	//  3: TABERR_BAD_PARAMS
				//  4: TABERR_BAD_X
				//  5: TABERR_BAD_WORLD
d66 1
a66 1
// Convenience macro for invoking wcserr_set().
d69 1
a69 1
// Internal helper functions, not for general use.
d76 1
a76 1
//----------------------------------------------------------------------------
d93 1
a93 1
  // Free memory previously allocated by wcstab().
d114 1
a114 1
  // Determine the number of -TAB axes.
d122 1
a122 1
    // Null fill.
d133 1
a133 1
    // No lookup tables.
d139 1
a139 1
  // Collect information from the PSi_ma and PVi_ma keyvalues.
d152 1
a152 1
    // Remember that calloc() zeroes allocated memory.
d163 1
a163 1
        // EXTNAME.
d168 1
a168 1
        // TTYPEn for coordinate array.
d173 1
a173 1
        // TTYPEn for index vector.
d186 1
a186 1
        // EXTVER.
d190 1
a190 1
        // EXTLEVEL.
d194 1
a194 1
        // Table axis number.
d202 1
a202 1
  // Determine the number of independent tables.
d204 1
a204 1
    // These have no defaults.
d213 2
a214 2
      // EXTNAME, EXTVER, EXTLEVEL, and TTYPEn for the coordinate array
      // must match for each axis of a multi-dimensional lookup table.
d236 1
a236 1
  // Table dimensionality; find the largest axis number.
d240 1
a240 1
    // PVi_3a records the 1-relative table axis number.
d254 1
a254 1
  // Copy parameters into the tabprm structs.
d257 1
a257 1
      // Not a -TAB axis.
d261 1
a261 1
    // PVi_3a records the 1-relative table axis number.
d269 1
a269 1
  // Check for completeness.
d281 1
a281 1
  // Set up for reading the arrays; how many arrays are there?
d283 1
a283 1
    // Does this -TAB axis have a non-degenerate index array?
d289 1
a289 1
  // Add one coordinate array for each table.
d292 1
a292 1
  // Allocate memory for structs to be returned.
d301 1
a301 1
  // Set pointers for the index and coordinate arrays.
d309 1
a309 1
        // Coordinate array.
d323 1
a323 1
        // Signal for tabset() to take this memory.
d331 1
a331 1
        // Index array.
d346 1
a346 1
        // Signal for tabset() to take this memory.
d374 1
a374 1
//----------------------------------------------------------------------------
d406 1
a406 1
//----------------------------------------------------------------------------
d436 1
a436 1
      // Pixel list.
d448 1
a448 1
      // Binary table image array.
d462 1
a462 1
//----------------------------------------------------------------------------
d487 9
a495 9
//----------------------------------------------------------------------------
#define I_DTYPE   0	// Distortion type code.
#define I_NIPARM  1	// Full (allocated) length of iparm[].
#define I_NDPARM  2	// No. of parameters in dparm[], excl. work space.
#define I_DOCORR  3	// True if distortion func computes a correction.
#define I_TPDNCO  4	// No. of TPD coefficients, forward...
#define I_TPDINV  5	// ...and inverse.
#define I_TPDAUX  6	// True if auxiliary variables are used.
#define I_TPDRAD  7	// True if the radial variable is used.
d499 1
a499 1
// ::: CUBEFACE and STOKES handling?
d535 1
a535 1
  // These are mainly for convenience.
d553 1
a553 1
  // Initialize floating point format control.
d580 1
a580 1
  // WCS dimension.
d587 1
a587 1
  // Reference pixel coordinates.
d596 1
a596 1
  // Linear transformation matrix.
d615 1
a615 1
  // Coordinate increment at reference point.
d626 1
a626 1
  // Units of coordinate increment and reference value.
d636 3
a638 3
  // May need to alter ctype for particular distortions so do basic checks
  // now.  Note that SIP, TPV, DSS, TNX, and ZPX are restricted to exactly
  // two axes and cannot coexist with other distortion types.
d646 2
a647 2
        // Simple Imaging Polynomial (SIP).  Write it in its native form
        // if possible, unless specifically requested to write it as TPD.
d666 2
a667 2
            // Must have been read as a 'SIP' distortion, CPDISja = 'SIP'.
            // Cannot be written as native SIP so write it as TPD.
d671 2
a672 2
            // Must have been permuted by wcssub().
            // Native SIP doesn't have axis mapping so write it as TPD.
d691 2
a692 2
        // TPV "projection".  Write it in its native form if possible,
        // unless specifically requested to write it as TPD.
d708 2
a709 2
            // Must have been read as a 'TPV' distortion, CPDISja = 'TPV'.
            // Cannot be written as native TPV so write it as TPD.
d723 1
a723 1
        // Always written as TPD.
d728 1
a728 1
        // Always written as TPD.
d743 1
a743 1
  // Coordinate type.
d752 1
a752 1
      // Alter ctype for particular distortions.
d754 1
a754 1
        // It could have come in as CPDISja = 'SIP'.
d757 1
a757 1
        // Reinstate projection code edited by wcsset().
d827 1
a827 1
  // Coordinate value at reference point.
d838 1
a838 1
  // Parameter values.
d890 1
a890 1
  // Celestial and spectral transformation parameters.
d919 1
a919 1
  // - - - - - - - - - - - - - - - - -  Auxiliary coordinate axis information.
d922 1
a922 1
  // Coordinate axis title.
d934 1
a934 1
  // Random error in coordinate.
d948 1
a948 1
  // Systematic error in coordinate.
d962 1
a962 1
  // Time at zero point of phase axis.
d974 1
a974 1
  // Period of phase axis.
d986 1
a986 1
  // - - - - - - - - - - - - - - - - - - - - - - - -  Coordinate system title.
d988 1
a988 1
  // Coordinate system title.
d996 1
a996 1
      // TWCS was a mistake.
d1003 1
a1003 1
  // - - - - - - - - - - - - - - - - -  Time reference system and measurement.
d1005 1
a1005 1
  // Time scale.
d1012 1
a1012 1
  // Time reference position.
d1019 1
a1019 1
  // Time reference direction.
d1026 1
a1026 1
  // Ephemerides used for pathlength delay calculation.
d1033 1
a1033 1
  // Time units.
d1040 1
a1040 1
  // Fiducial (reference) time.
d1042 1
a1042 1
    // MJD of fiducial time (simplified if it takes its default value).
d1048 1
a1048 1
    // ISO-8601 fiducial time.
d1056 1
a1056 1
      // MJD of fiducial time (no fractional part).
d1064 1
a1064 1
      // MJD of fiducial time, integer part.
d1072 1
a1072 1
      // MJD of fiducial time, fractional part.
d1082 1
a1082 1
  // Clock correction.
d1090 1
a1090 1
  // - - - - - - - - - - - - - - - - - - - - -  Data timestamps and durations.
d1092 1
a1092 1
  // ISO-8601 time of observation.
d1098 1
a1098 1
      // Allow DOBSn.
d1102 1
a1102 1
      // Force DATE-OBS.
d1108 1
a1108 1
  // MJD of observation.
d1116 1
a1116 1
  // Julian epoch of observation.
d1123 1
a1123 1
  // Besselian epoch of observation.
d1130 1
a1130 1
  // ISO-8601 time at start of observation.
d1137 1
a1137 1
  // MJD at start of observation.
d1144 1
a1144 1
  // Time elapsed at start since fiducial time.
d1153 1
a1153 1
  // ISO-8601 time at midpoint of observation.
d1161 1
a1161 1
  // MJD at midpoint of observation.
d1169 1
a1169 1
  // ISO-8601 time at end of observation.
d1176 1
a1176 1
  // MJD at end of observation.
d1183 1
a1183 1
  // Time elapsed at end since fiducial time.
d1192 1
a1192 1
  // Exposure (integration) time.
d1200 1
a1200 1
  // Elapsed time (start to stop).
d1208 1
a1208 1
  // - - - - - - - - - - - - - - - - - - - - - - - - - - - -  Timing accuracy.
d1210 1
a1210 1
  // Systematic error in time measurements.
d1218 1
a1218 1
  // Relative error in time measurements.
d1226 1
a1226 1
  // Time resolution.
d1234 1
a1234 1
  // Reference position of timestamp in binned data.
d1242 1
a1242 1
  // - - - - - - - - - - - - - - - - - -  Spatial & celestial reference frame.
d1244 1
a1244 1
  // Observatory coordinates.
d1276 1
a1276 1
  // Spacecraft orbit ephemeris file.
d1283 1
a1283 1
  // Equatorial coordinate system type.
d1290 1
a1290 1
  // Equinox of equatorial coordinate system.
d1298 1
a1298 1
  // Reference frame of spectral coordinates.
d1306 1
a1306 1
  // Reference frame of spectral observation.
d1314 1
a1314 1
  // Observer's velocity towards source.
d1321 1
a1321 1
  // Redshift of the source.
d1328 1
a1328 1
  // Reference frame of source redshift.
d1336 1
a1336 1
  // Velocity orientation angle.
d1343 1
a1343 1
  // - - - - - - - - - - - - - - - - - - - -  Additional auxiliary parameters.
d1388 1
a1388 1
  // - - - - - - - - - - - - - - - - - - - - - Distortion function parameters.
d1391 4
a1394 4
    // Simple Imaging Polynomial (SIP) is handled by translating its dpkey
    // records.  Determine a suitable numerical precision for the
    // polynomial coefficients to avoid trailing zeroes common to all of
    // them.
d1415 1
a1415 1
    // Ensure the coefficients are written in a human-readable sequence.
d1417 1
a1417 1
      // Distortion function polynomial coefficients.
d1466 1
a1466 1
      // Inverse distortion function polynomial coefficients.
d1521 1
a1521 1
      // Identify the distortion type.
d1523 5
a1527 5
        // TPV "projection" is handled by translating its dpkey records,
        // which were originally translated from PVi_ma by wcsset(), or
        // possibly input directly as a CQDISia = 'TPV' distortion type.
        // Determine a suitable numerical precision for the polynomial
        // coefficients to avoid trailing zeroes common to all of them.
d1534 1
a1534 1
        // Distortion function polynomial coefficients.
d1547 1
a1547 1
          // Identify the term of the TPV polynomial for human readers.
d1564 1
a1564 1
        // One of the Paper IV type polynomial distortions.
d1569 1
a1569 1
          // Pure TPD.
d1572 1
a1572 1
          // Polynomial distortion.  Write it as TPD by request?
d1580 1
a1580 1
        // CPDISja/CQDISia
d1592 1
a1592 1
          // For identifying terms of the TPD polynomial.
d1597 1
a1597 1
            // Associate x with longitude, y with latitude.
d1603 1
a1603 1
              // Non-celestial.
d1615 1
a1615 1
        // NAXES.
d1628 1
a1628 1
        // AXIS.jhat
d1645 1
a1645 1
            // axid is "xyxuvu".
d1656 1
a1656 1
        // OFFSET.jhat
d1669 1
a1669 1
        // SCALE.jhat
d1682 1
a1682 1
        // Does the distortion function compute a correction?
d1690 4
a1693 4
          // Template Polynomial Distortion (TPD).  As it may have been
          // translated from SIP, TPV, DSS, TNX, ZPX, or perhaps
          // Polynomial, the dpkey records may not relate to TPD.
          // Output is therefore handled via dparm.
d1697 1
a1697 1
          // AUX.jhat.COEFF.m
d1724 1
a1724 1
          // TPD.FWD.m
d1743 1
a1743 1
          // CPERRja/CQERRia
d1753 1
a1753 1
          // Inverse distortion function polynomial coefficients.
d1759 1
a1759 1
          // TPD.REV.m
d1775 2
a1776 2
          // General polynomial distortion, handled via its dpkey records
          // since iparm and dparm may hold a translation to TPD.
d1778 1
a1778 1
          // Do auxiliary variables first.
d1837 1
a1837 1
          // Do polynomial terms.
d1889 1
a1889 1
          // CPERRja/CQERRia
d1902 1
a1902 1
    // DVERRa
d1912 1
a1912 1
  // Add identification.
d1917 1
a1917 1
    // TPD by translation.
d1935 2
a1936 2
//----------------------------------------------------------------------------
// Determine a suitable floating point format for a set of parameters.
d1961 2
a1962 2
    // Double precision has at least 15 significant digits, and up to 17:
    // http://en.wikipedia.org/wiki/Double-precision_floating-point_format
d1994 2
a1995 2
//----------------------------------------------------------------------------
// Construct a string that identifies the term of a TPD or TPV polynomial.
d2031 2
a2032 2
//----------------------------------------------------------------------------
// Construct a keyrecord from the components given.
d2058 1
a2058 1
  // Reallocate memory in blocks of 2880 bytes.
d2069 1
a2069 1
  // Construct the keyword.
d2072 1
a2072 1
    // Binary table image array.
d2088 1
a2088 1
      // Use the long form.
d2105 1
a2105 1
    // Pixel list.
d2121 1
a2121 1
      // Use the long form.
d2152 1
a2152 1
  // Double-up single-quotes in string keyvalues.
d2173 1
a2173 1
    // Check length.
d2175 1
a2175 1
      // Truncate.
d2181 1
a2181 1
    // Check length.
d2183 1
a2183 1
      // Truncate.
d2189 1
a2189 1
    // Rob the keycomment to make space for the keyvalue.
@


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: wcshdr.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: wcshdr.c,v 7.3.1.3 2021/01/19 14:09:10 mcalabre Exp mcalabre $
@


7.3.1.5
log
@Fixed a bad bug in wcshdo_format() that caused precision to be lost for 'f'
format output, in the worst case with non-zero values output as 0.0.
@
text
@d22 1
a22 1
  $Id: wcshdr.c,v 7.3.1.4 2021/01/28 12:29:30 mcalabre Exp mcalabre $
d1942 16
a1957 4
  int emax = -999;
  int emin = +999;
  int precision = 0;
  for (int i = 0; i < nval; i++) {
a1959 1
    char cval[24];
d1962 3
a1964 2
    int cpi = 16;
    while (2 < cpi && cval[cpi] == '0') cpi--;
a1965 6
    // Precision for 'E' format.
    cpi -= 2;
    if (precision < cpi) precision = cpi;

    // Range of significant digits for 'f' format.
    int expon;
d1967 1
a1967 4

    if (emax < expon) emax = expon;
    expon -= cpi;
    if (expon < emin) emin = expon;
d1970 1
a1971 10
  if (fmt == 'G') {
    // Because e.g. writing 1e4 as 10000 requires an extra digit.
    emax++;

    if (emin < -15 || 15 < emax || 15 < (emax - emin)) {
      fmt = 'E';
    } else {
      fmt = 'f';
    }
  }
d1974 1
a1974 1
    precision = -emin;
d1980 1
@


7.3.1.6
log
@In wcshdo(), fixed a bug introduced in release 7.1 that caused the 
coefficients of the TPD distortion function not to be written to the 
header.  Also, TPD and Polynomial distortion function headers will now 
always include the DPja.DOCORR keyword, regardless of its value.
@
text
@d22 1
a22 1
  $Id: wcshdr.c,v 7.3.1.5 2021/01/29 04:09:15 mcalabre Exp mcalabre $
a484 1
// Matching the definitions in dis.c.
d488 5
a492 4
#define I_TPDNCO  3	// No. of TPD coefficients, forward...
#define I_TPDINV  4	// ...and inverse.
#define I_TPDAUX  5	// True if auxiliary variables are used.
#define I_TPDRAD  6	// True if the radial variable is used.
d1680 1
a1680 1
        if (dis->docorr[j]) {
a1682 4
            nkeyrec, header, &status);
        } else {
          wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
            "'DOCORR: 0'", "Distortion function computes coordinates",
@


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: wcshdr.c,v 7.1.1.1 2019/12/31 13:28:19 mcalabre Exp mcalabre $
d1040 40
a1079 19
  /* ISO-8601 fiducial time. */
  if (wcs->dateref[0]) {
    sprintf(keyvalue, "'%s'", wcs->dateref);
    wcshdo_util(ctrl, "DATEREF", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "ISO-8601 fiducial time", nkeyrec, header, &status);
  }

  /* MJD of fiducial time, integer part. */
  if (!undefined(wcs->mjdref[0])) {
    wcsutil_double2str(keyvalue, format, wcs->mjdref[0]);
    wcshdo_util(ctrl, "MJDREFI", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "[d] MJD of fiducial time, integer part", nkeyrec, header, &status);
  }

  /* MJD of fiducial time, fractional part. */
  if (!undefined(wcs->mjdref[1])) {
    wcsutil_double2str(keyvalue, format, wcs->mjdref[1]);
    wcshdo_util(ctrl, "MJDREFF", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "[d] MJD of fiducial time, fractional part", nkeyrec, header, &status);
d1138 4
a1141 5
  if (!undefined(wcs->mjdobs)) {
    wcsutil_double2str(keyvalue, format, wcs->mjdobs);
    wcshdo_util(ctrl, "MJD-OBS", "MJDOB", 0, 0x0, 0, 0, 0, ' ',
      colnum, colax, keyvalue, "[d] MJD at start of observation",
      nkeyrec, header, &status);
@


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


7.2.1.2
log
@In wcshdo(), MJD-OBS was being written twice, and MJD-BEG not at all.
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 7.2.1.1 2020/03/09 07:34:50 mcalabre Exp mcalabre $
d1117 5
a1121 4
  if (!undefined(wcs->mjdbeg)) {
    wcsutil_double2str(keyvalue, format, wcs->mjdbeg);
    wcshdo_util(ctrl, "MJD-BEG", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "[d] MJD at start of observation", nkeyrec, header, &status);
@


7.2.1.3
log
@In wcshdo(), if MJDREF assumes its default value, just write MJDREF = 0 
(not MJDREFI + MJDREFF), and omit writing DATEREF, which, with a value of
'1858-11-17', is potentially confusing.  If wcsprm::mjdref[1] == 0, then
just write wcsprm::mjdref[1] as MJDREF (not MJDREFI + MJDREFF).
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 7.2.1.2 2020/05/27 13:32:40 mcalabre Exp mcalabre $
d1040 19
a1058 40
  /* Fiducial (reference) time. */
  if (wcs->mjdref[0] == 0.0 && wcs->mjdref[1] == 0.0) {
    /* MJD of fiducial time (simplified if it takes its default value). */
    wcsutil_double2str(keyvalue, format, 0.0);
    wcshdo_util(ctrl, "MJDREF", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "[d] MJD of fiducial time", nkeyrec, header, &status);

  } else {
    /* ISO-8601 fiducial time. */
    if (wcs->dateref[0]) {
      sprintf(keyvalue, "'%s'", wcs->dateref);
      wcshdo_util(ctrl, "DATEREF", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        keyvalue, "ISO-8601 fiducial time", nkeyrec, header, &status);
    }

    if (wcs->mjdref[1] == 0.0) {
      /* MJD of fiducial time (no fractional part). */
      if (!undefined(wcs->mjdref[0])) {
        wcsutil_double2str(keyvalue, format, wcs->mjdref[0]);
        wcshdo_util(ctrl, "MJDREF", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
          keyvalue, "[d] MJD of fiducial time", nkeyrec, header, &status);
      }

    } else {
      /* MJD of fiducial time, integer part. */
      if (!undefined(wcs->mjdref[0])) {
        wcsutil_double2str(keyvalue, format, wcs->mjdref[0]);
        wcshdo_util(ctrl, "MJDREFI", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
          keyvalue, "[d] MJD of fiducial time, integer part", nkeyrec,
          header, &status);
      }

      /* MJD of fiducial time, fractional part. */
      if (!undefined(wcs->mjdref[1])) {
        wcsutil_double2str(keyvalue, format, wcs->mjdref[1]);
        wcshdo_util(ctrl, "MJDREFF", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
          keyvalue, "[d] MJD of fiducial time, fractional part", nkeyrec,
          header, &status);
      }
    }
@


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: wcshdr.c,v 6.4.1.5 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: wcshdr.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: wcshdr.c,v 6.3.1.1 2019/07/12 07:34:37 mcalabre Exp mcalabre $
d508 1
a508 1
       keyvalue[96], keyword[16], *kp, *kp0, obsg[8] = "OBSG?",
d512 2
a513 2
       dosip, dotpd, dotpv, i, idis, idp, *iparm, j, jhat, k, m, naxis,
       ncoeff, Nhat, p, pixlist, precision, primage, q, status = 0;
d515 1
d1323 46
a1369 1
  /* Write distortion function parameters. */
d1378 1
a1378 1
      kp0  = keyvalue + 2;
d1384 3
a1386 3
        kp = keyvalue + 15;
        while (kp0 < kp && *kp == '0') kp--;
        kp0 = kp;
d1389 1
a1389 1
      precision = kp0 - (keyvalue + 2);
d1925 2
a1926 2
  char *cp, *cp0, cval[24];
  int  i, expmax, expon, nsig, precision;
d1938 1
a1938 1
  cp0 = cval + 2;
d1945 3
a1947 3
    cp = cval + 16;
    while (cp0 < cp && *cp == '0') cp--;
    cp0 = cp;
d1953 1
a1953 1
  nsig = cp0 - (cval + 2) + 1;
d1998 1
a1998 1
      strncpy(term, "rrrrrrrrr", degree);
d2000 2
a2001 2
      strncpy(term, "xxxxxxxxx", k);
      strncpy(term+k, "yyyyyyyyy", degree-k);
d2003 2
a2004 2
      strncpy(term, "yyyyyyyyy", k);
      strncpy(term+k, "xxxxxxxxx", degree-k);
@


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


6.4.1.2
log
@In wcshdo_tpdterm(), as recommended in the GCC 9.2.0 man page, substituted
memcpy() for five instances of strncpy() that generated nuisance warnings
with -Wstringop-truncation (via -Wall).
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 6.4.1.1 2019/08/15 09:31:29 mcalabre Exp mcalabre $
d1952 1
a1952 1
      memcpy(term, "rrrrrrrrr", degree);
d1954 2
a1955 2
      memcpy(term, "xxxxxxxxx", k);
      memcpy(term+k, "yyyyyyyyy", degree-k);
d1957 2
a1958 2
      memcpy(term, "yyyyyyyyy", k);
      memcpy(term+k, "xxxxxxxxx", degree-k);
@


6.4.1.3
log
@In wcshdo() and wcshdo_format(), reworked pointer arithmetic to quell
warnings from Microsoft Visual C++ (MSVC).
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 6.4.1.2 2019/12/01 05:36:29 mcalabre Exp mcalabre $
d508 1
a508 1
       keyvalue[96], keyword[16], *kp, obsg[8] = "OBSG?",
d512 2
a513 2
       dosip, dotpd, dotpv, i, idis, idp, *iparm, j, jhat, k, kp0, kpi, m,
       naxis, ncoeff, Nhat, p, pixlist, precision, primage, q, status = 0;
d1332 1
a1332 1
      kp0  = 2;
d1338 3
a1340 3
        kpi = 15;
        while (kp0 < kpi && keyvalue[kpi] == '0') kpi--;
        kp0 = kpi;
d1343 1
a1343 1
      precision = kp0 - 2;
d1879 2
a1880 2
  char cval[24];
  int  cp0, cpi, i, expmax, expon, nsig, precision;
d1892 1
a1892 1
  cp0 = 2;
d1899 3
a1901 3
    cpi = 16;
    while (cp0 < cpi && cval[cpi] == '0') cpi--;
    cp0 = cpi;
d1907 1
a1907 1
  nsig = cp0 - 1;
@


6.4.1.4
log
@In wcshdo(), write additional auxiliary coordinate system information
stored in auxprm.
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 6.4.1.3 2019/12/16 04:46:38 mcalabre Exp mcalabre $
a514 1
  struct auxprm *aux;
a1321 46
  /* - - - - - - - - - - - - - - - - - - - Additional auxiliary parameters. */

  if ((aux = wcs->aux)) {
    if (!undefined(aux->rsun_ref)) {
      wcsutil_double2str(keyvalue, format, aux->rsun_ref);
      wcshdo_util(ctrl, "RSUN_REF", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        keyvalue, "[m] Solar radius", nkeyrec, header, &status);
    }

    if (!undefined(aux->dsun_obs)) {
      wcsutil_double2str(keyvalue, format, aux->dsun_obs);
      wcshdo_util(ctrl, "DSUN_OBS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        keyvalue, "[m] Distance from centre of Sun to observer", nkeyrec,
        header, &status);
    }

    if (!undefined(aux->crln_obs)) {
      wcsutil_double2str(keyvalue, format, aux->crln_obs);
      wcshdo_util(ctrl, "CRLN_OBS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        keyvalue, "[deg] Carrington heliographic lng of observer", nkeyrec,
        header, &status);

      if (!undefined(aux->hglt_obs)) {
        wcsutil_double2str(keyvalue, format, aux->hglt_obs);
        wcshdo_util(ctrl, "CRLT_OBS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
          keyvalue, "[deg] Heliographic latitude of observer", nkeyrec,
          header, &status);
      }
    }

    if (!undefined(aux->hgln_obs)) {
      wcsutil_double2str(keyvalue, format, aux->hgln_obs);
      wcshdo_util(ctrl, "HGLN_OBS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
        keyvalue, "[deg] Stonyhurst heliographic lng of observer", nkeyrec,
        header, &status);

      if (!undefined(aux->hglt_obs)) {
        wcsutil_double2str(keyvalue, format, aux->hglt_obs);
        wcshdo_util(ctrl, "HGLT_OBS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0,
          keyvalue, "[deg] Heliographic latitude of observer", nkeyrec,
          header, &status);
      }
    }
  }

  /* - - - - - - - - - - - - - - - - - - - Distortion function parameters.  */
d1323 1
@


6.4.1.5
log
@Updated date in copyright notice.
@
text
@d4 1
a4 1
  Copyright (C) 1995-2020, Mark Calabretta
d25 1
a25 1
  $Id: wcshdr.c,v 6.4.1.4 2019/12/31 02:29:05 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: wcshdr.c,v 6.2.1.3 2019/07/09 08:52:45 mcalabre Exp mcalabre $
@


6.3.1.1
log
@WCSLIB 6.3 development branch.
@
text
@d25 1
a25 1
  $Id: wcshdr.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: wcshdr.c,v 6.1.1.1 2018/10/19 08:36:15 mcalabre Exp mcalabre $
d493 1
a493 1
#define I_TPDINV  5     /* ...and inverse.                                  */
@


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


6.2.1.3
log
@Whitespace.
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 6.2.1.2 2019/05/10 01:56:50 mcalabre Exp mcalabre $
d493 1
a493 1
#define I_TPDINV  5	/* ...and inverse.                                  */
@


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: wcshdr.c,v 5.20.1.2 2018/10/19 07:30:46 mcalabre Exp mcalabre $
@


6.1.1.1
log
@WCSLIB 6.1 development branch.
@
text
@d25 1
a25 1
  $Id: wcshdr.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: wcshdr.c,v 5.19.1.2 2018/10/05 04:44:10 mcalabre Exp mcalabre $
d38 1
d509 4
a512 4
       obsgeo[8] = "OBSGEO-?", pq, ptype, xtype, term[16], tpdsrc[24],
       xyz[] = "XYZ";
  int  *axmap, bintab, col0, *colax, colnum, degree, direct = 0, doaux = 0,
       dofmt, dosip, dotpd, dotpv, i, idis, idp, *iparm, j, jhat, k, m, naxis,
a544 1
    col0 = colnum;
a546 1
    col0 = colax[0];
d918 2
a919 14
  /* Coordinate system title. */
  if (wcs->wcsname[0]) {
    sprintf(keyvalue, "'%s'", wcs->wcsname);
    if (bintab) {
      wcshdo_util(ctrl, "WCSNAME", "WCSN", 0, 0x0, 0, 0, 0, alt,
        colnum, colax, keyvalue, "Coordinate system title",
        nkeyrec, header, &status);
    } else {
      /* TWCS was a mistake. */
      wcshdo_util(ctrl, "WCSNAME", "TWCS", WCSHDO_WCSNna, "WCSN", 0, 0, 0,
        alt, colnum, colax, keyvalue, "Coordinate system title",
        nkeyrec, header, &status);
    }
  }
d961 62
a1022 6
  /* Equatorial coordinate system type. */
  if (wcs->radesys[0]) {
    sprintf(keyvalue, "'%s'", wcs->radesys);
    wcshdo_util(ctrl, "RADESYS", "RADE", 0, 0x0, 0, 0, 0, alt,
      colnum, colax, keyvalue, "Equatorial coordinate system",
      nkeyrec, header, &status);
d1025 5
a1029 6
  /* Equinox of equatorial coordinate system. */
  if (!undefined(wcs->equinox)) {
    wcsutil_double2str(keyvalue, format, wcs->equinox);
    wcshdo_util(ctrl, "EQUINOX", "EQUI", 0, 0x0, 0, 0, 0, alt,
      colnum, colax, keyvalue, "[yr] Equinox of equatorial coordinates",
      nkeyrec, header, &status);
d1032 5
a1036 6
  /* Reference frame of spectral coordinates. */
  if (wcs->specsys[0]) {
    sprintf(keyvalue, "'%s'", wcs->specsys);
    wcshdo_util(ctrl, "SPECSYS", "SPEC", 0, 0x0, 0, 0, 0, alt,
      colnum, colax, keyvalue, "Reference frame of spectral coordinates",
      nkeyrec, header, &status);
d1039 5
a1043 6
  /* Reference frame of spectral observation. */
  if (wcs->ssysobs[0]) {
    sprintf(keyvalue, "'%s'", wcs->ssysobs);
    wcshdo_util(ctrl, "SSYSOBS", "SOBS", 0, 0x0, 0, 0, 0, alt,
      colnum, colax, keyvalue, "Reference frame of spectral observation",
      nkeyrec, header, &status);
d1046 5
a1050 6
  /* Observer's velocity towards source. */
  if (!undefined(wcs->velosys)) {
    wcsutil_double2str(keyvalue, format, wcs->velosys);
    wcshdo_util(ctrl, "VELOSYS", "VSYS", 0, 0x0, 0, 0, 0, alt,
      colnum, colax, keyvalue, "[m/s] Velocity towards source",
      nkeyrec, header, &status);
d1053 5
a1057 6
  /* Reference frame of source redshift. */
  if (wcs->ssyssrc[0]) {
    sprintf(keyvalue, "'%s'", wcs->ssyssrc);
    wcshdo_util(ctrl, "SSYSSRC", "SSRC", 0, 0x0, 0, 0, 0, alt,
      colnum, colax, keyvalue, "Reference frame of source redshift",
      nkeyrec, header, &status);
d1060 6
a1065 6
  /* Redshift of the source. */
  if (!undefined(wcs->zsource)) {
    wcsutil_double2str(keyvalue, format, wcs->zsource);
    wcshdo_util(ctrl, "ZSOURCE", "ZSOU", 0, 0x0, 0, 0, 0, alt,
      colnum, colax, keyvalue, "Redshift of the source",
      nkeyrec, header, &status);
d1068 6
a1073 3
  /* Observatory coordinates. */
  for (k = 0; k < 3; k++) {
    if (undefined(wcs->obsgeo[k])) continue;
d1075 9
a1083 6
    wcsutil_double2str(keyvalue, format, wcs->obsgeo[k]);
    sprintf(comment, "[m] ITRF observatory %c-coordinate", xyz[k]);
    obsgeo[7] = xyz[k];
    obsg[4]   = xyz[k];
    wcshdo_util(ctrl, obsgeo, obsg, 0, 0x0, 0, 0, 0, ' ',
      colnum, colax, keyvalue, comment, nkeyrec, header, &status);
d1089 18
d1108 6
a1113 8
    strcpy(comment, "[d] MJD of observation");
    if (wcs->dateobs[0]) {
      if (primage || (ctrl & 1) == 0) {
        sprintf(comment+22, " matching DATE-OBS");
      } else {
        sprintf(comment+22, " matching DOBS%d", col0);
      }
    }
d1115 3
d1119 19
a1137 1
      colnum, colax, keyvalue, comment, nkeyrec, header, &status);
d1140 1
a1140 1
  /* MJD mid-observation time. */
d1143 61
d1205 63
a1267 8
    strcpy(comment, "[d] MJD mid-observation");
    if (wcs->dateavg[0]) {
      if (primage) {
        sprintf(comment+23, " matching DATE-AVG");
      } else {
        sprintf(comment+23, " matching DAVG%d", col0);
      }
    }
d1269 6
a1274 2
    wcshdo_util(ctrl, "MJD-AVG", "MJDA", 0, 0x0, 0, 0, 0, ' ',
      colnum, colax, keyvalue, comment, nkeyrec, header, &status);
d1277 7
a1283 3
  /* ISO-8601 date corresponding to MJD-OBS. */
  if (wcs->dateobs[0]) {
    sprintf(keyvalue, "'%s'", wcs->dateobs);
d1285 7
a1291 8
    strcpy(comment, "ISO-8601 observation date");
    if (!undefined(wcs->mjdobs)) {
      if (primage) {
        sprintf(comment+25, " matching MJD-OBS");
      } else {
        sprintf(comment+25, " matching MJDOB%d", col0);
      }
    }
d1293 5
a1297 9
    if (ctrl & 1) {
      /* Allow DOBSn. */
      wcshdo_util(ctrl, "DATE-OBS", "DOBS", WCSHDO_DOBSn, 0x0, 0, 0, 0,
        ' ', colnum, colax, keyvalue, comment, nkeyrec, header, &status);
    } else {
      /* Force DATE-OBS. */
      wcshdo_util(ctrl, "DATE-OBS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0,
        0x0, keyvalue, comment, nkeyrec, header, &status);
    }
d1300 6
a1305 3
  /* ISO-8601 date corresponding to MJD-OBS. */
  if (wcs->dateavg[0]) {
    sprintf(keyvalue, "'%s'", wcs->dateavg);
d1307 7
a1313 8
    strcpy(comment, "ISO-8601 mid-observation date");
    if (!undefined(wcs->mjdavg)) {
      if (primage) {
        sprintf(comment+29, " matching MJD-AVG");
      } else {
        sprintf(comment+29, " matching MJDA%d", col0);
      }
    }
d1315 5
a1319 2
    wcshdo_util(ctrl, "DATE-AVG", "DAVG", 0, 0x0, 0, 0, 0, ' ',
      colnum, colax, keyvalue, comment, nkeyrec, header, &status);
@


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


5.20.1.2
log
@Added support for time-related WCS keywords (Paper VII) to wcshdo().  Need to
include wtbarr.h now to get the definition of the wtbarr struct as it has been
moved out of wcs.h.
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 5.20.1.1 2018/10/05 05:33:33 mcalabre Exp mcalabre $
a37 1
#include "wtbarr.h"
d508 4
a511 4
       obsgeo[8] = "OBSGEO-?", pq, ptype, xtype, term[16], timeunit[16],
       tpdsrc[24], xyz[] = "XYZ";
  int  *axmap, bintab, *colax, colnum, degree, direct = 0, doaux = 0, dofmt,
       dosip, dotpd, dotpv, i, idis, idp, *iparm, j, jhat, k, m, naxis,
d544 1
d547 1
d919 14
a932 2
  /* - - - - - - - - - - - - - - - - Auxiliary coordinate axis information. */
  sprintf(timeunit, "%.15s", wcs->timeunit[0] ? wcs->timeunit : "s");
d974 6
a979 10
  /* Time at zero point of phase axis. */
  if (wcs->czphs) {
    for (i = 0; i < naxis; i++) {
      if (undefined(wcs->czphs[i])) continue;

      wcsutil_double2str(keyvalue, format, wcs->czphs[i]);
      sprintf(comment, "[%s] Time at zero point of phase axis", timeunit);
      wcshdo_util(ctrl, "CZPHS", "CZP", WCSHDO_CNAMna, "CZPH", i+1, 0, 0,
        alt, colnum, colax, keyvalue, comment, nkeyrec, header, &status);
    }
d982 6
a987 10
  /* Period of phase axis. */
  if (wcs->cperi) {
    for (i = 0; i < naxis; i++) {
      if (undefined(wcs->cperi[i])) continue;

      wcsutil_double2str(keyvalue, format, wcs->cperi[i]);
      sprintf(comment, "[%s] Period of phase axis", timeunit);
      wcshdo_util(ctrl, "CPERI", "CPR", WCSHDO_CNAMna, "CPER", i+1, 0, 0,
        alt, colnum, colax, keyvalue, comment, nkeyrec, header, &status);
    }
d990 6
a995 15
  /* - - - - - - - - - - - - - - - - - - - - - -  Coordinate system title.  */

  /* Coordinate system title. */
  if (wcs->wcsname[0]) {
    sprintf(keyvalue, "'%s'", wcs->wcsname);
    if (bintab) {
      wcshdo_util(ctrl, "WCSNAME", "WCSN", 0, 0x0, 0, 0, 0, alt,
        colnum, colax, keyvalue, "Coordinate system title",
        nkeyrec, header, &status);
    } else {
      /* TWCS was a mistake. */
      wcshdo_util(ctrl, "WCSNAME", "TWCS", WCSHDO_WCSNna, "WCSN", 0, 0, 0,
        alt, colnum, colax, keyvalue, "Coordinate system title",
        nkeyrec, header, &status);
    }
d998 6
a1003 7
  /* - - - - - - - - - - - - - - - - Time reference system and measurement. */

  /* Time scale. */
  if (wcs->timesys[0]) {
    sprintf(keyvalue, "'%s'", wcs->timesys);
    wcshdo_util(ctrl, "TIMESYS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "Time scale", nkeyrec, header, &status);
d1006 6
a1011 5
  /* Time reference position. */
  if (wcs->trefpos[0]) {
    sprintf(keyvalue, "'%s'", wcs->trefpos);
    wcshdo_util(ctrl, "TREFPOS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "Time reference position", nkeyrec, header, &status);
d1014 6
a1019 5
  /* Time reference direction. */
  if (wcs->trefdir[0]) {
    sprintf(keyvalue, "'%s'", wcs->trefdir);
    wcshdo_util(ctrl, "TREFDIR", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "Time reference direction", nkeyrec, header, &status);
d1022 6
a1027 5
  /* Ephemerides used for pathlength delay calculation. */
  if (wcs->plephem[0]) {
    sprintf(keyvalue, "'%s'", wcs->plephem);
    wcshdo_util(ctrl, "PLEPHEM", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "Ephemerides used for pathlength delays", nkeyrec, header, &status);
d1030 3
a1032 6
  /* Time units. */
  if (wcs->timeunit[0]) {
    sprintf(keyvalue, "'%s'", wcs->timeunit);
    wcshdo_util(ctrl, "TIMEUNIT", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "Time units", nkeyrec, header, &status);
  }
d1034 6
a1039 45
  /* ISO-8601 fiducial time. */
  if (wcs->dateref[0]) {
    sprintf(keyvalue, "'%s'", wcs->dateref);
    wcshdo_util(ctrl, "DATEREF", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "ISO-8601 fiducial time", nkeyrec, header, &status);
  }

  /* MJD of fiducial time, integer part. */
  if (!undefined(wcs->mjdref[0])) {
    wcsutil_double2str(keyvalue, format, wcs->mjdref[0]);
    wcshdo_util(ctrl, "MJDREFI", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "[d] MJD of fiducial time, integer part", nkeyrec, header, &status);
  }

  /* MJD of fiducial time, fractional part. */
  if (!undefined(wcs->mjdref[1])) {
    wcsutil_double2str(keyvalue, format, wcs->mjdref[1]);
    wcshdo_util(ctrl, "MJDREFF", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "[d] MJD of fiducial time, fractional part", nkeyrec, header, &status);
  }

  /* Clock correction. */
  if (!undefined(wcs->timeoffs)) {
    wcsutil_double2str(keyvalue, format, wcs->timeoffs);
    sprintf(comment, "[%s] Clock correction", timeunit);
    wcshdo_util(ctrl, "TIMEOFFS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      comment, nkeyrec, header, &status);
  }

  /* - - - - - - - - - - - - - - - - - - - - Data timestamps and durations. */

  /* ISO-8601 time of observation. */
  if (wcs->dateobs[0]) {
    sprintf(keyvalue, "'%s'", wcs->dateobs);
    strcpy(comment, "ISO-8601 time of observation");

    if (ctrl & 1) {
      /* Allow DOBSn. */
      wcshdo_util(ctrl, "DATE-OBS", "DOBS", WCSHDO_DOBSn, 0x0, 0, 0, 0, ' ',
        colnum, colax, keyvalue, comment, nkeyrec, header, &status);
    } else {
      /* Force DATE-OBS. */
      wcshdo_util(ctrl, "DATE-OBS", 0x0, 0, 0x0, 0, 0, 0, ' ',
        0, 0x0, keyvalue, comment, nkeyrec, header, &status);
    }
a1044 4
    wcshdo_util(ctrl, "MJD-OBS", "MJDOB", 0, 0x0, 0, 0, 0, ' ',
      colnum, colax, keyvalue, "[d] MJD of observation",
      nkeyrec, header, &status);
  }
d1046 8
a1053 13
  /* Julian epoch of observation. */
  if (!undefined(wcs->jepoch)) {
    wcsutil_double2str(keyvalue, format, wcs->jepoch);
    wcshdo_util(ctrl, "JEPOCH", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "[a] Julian epoch of observation", nkeyrec, header, &status);
  }

  /* Besselian epoch of observation. */
  if (!undefined(wcs->bepoch)) {
    wcsutil_double2str(keyvalue, format, wcs->bepoch);
    wcshdo_util(ctrl, "BEPOCH", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "[a] Besselian epoch of observation", nkeyrec, header, &status);
  }
a1054 10
  /* ISO-8601 time at start of observation. */
  if (wcs->datebeg[0]) {
    sprintf(keyvalue, "'%s'", wcs->datebeg);
    wcshdo_util(ctrl, "DATE-BEG", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "ISO-8601 time at start of observation", nkeyrec, header, &status);
  }

  /* MJD at start of observation. */
  if (!undefined(wcs->mjdobs)) {
    wcsutil_double2str(keyvalue, format, wcs->mjdobs);
d1056 1
a1056 2
      colnum, colax, keyvalue, "[d] MJD at start of observation",
      nkeyrec, header, &status);
d1059 1
a1059 18
  /* Time elapsed at start since fiducial time. */
  if (!undefined(wcs->tstart)) {
    wcsutil_double2str(keyvalue, format, wcs->tstart);
    sprintf(comment, "[%s] Time elapsed since fiducial time at start",
      timeunit);
    wcshdo_util(ctrl, "TSTART", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      comment, nkeyrec, header, &status);
  }

  /* ISO-8601 time at midpoint of observation. */
  if (wcs->dateavg[0]) {
    sprintf(keyvalue, "'%s'", wcs->dateavg);
    wcshdo_util(ctrl, "DATE-AVG", "DAVG", 0, 0x0, 0, 0, 0, ' ',
      colnum, colax, keyvalue, "ISO-8601 time at midpoint of observation",
      nkeyrec, header, &status);
  }

  /* MJD at midpoint of observation. */
a1061 4
    wcshdo_util(ctrl, "MJD-AVG", "MJDA", 0, 0x0, 0, 0, 0, ' ',
      colnum, colax, keyvalue, "[d] MJD at midpoint of observation",
      nkeyrec, header, &status);
  }
d1063 8
a1070 6
  /* ISO-8601 time at end of observation. */
  if (wcs->dateend[0]) {
    sprintf(keyvalue, "'%s'", wcs->dateend);
    wcshdo_util(ctrl, "DATE-END", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "ISO-8601 time at end of observation", nkeyrec, header, &status);
  }
d1072 2
a1073 5
  /* MJD at end of observation. */
  if (!undefined(wcs->mjdend)) {
    wcsutil_double2str(keyvalue, format, wcs->mjdend);
    wcshdo_util(ctrl, "MJD-END", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "[d] MJD at end of observation", nkeyrec, header, &status);
d1076 3
a1078 8
  /* Time elapsed at end since fiducial time. */
  if (!undefined(wcs->tstop)) {
    wcsutil_double2str(keyvalue, format, wcs->tstop);
    sprintf(comment, "[%s] Time elapsed since fiducial time at end",
      timeunit);
    wcshdo_util(ctrl, "TSTOP", "", 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      comment, nkeyrec, header, &status);
  }
d1080 8
a1087 7
  /* Exposure (integration) time. */
  if (!undefined(wcs->xposure)) {
    wcsutil_double2str(keyvalue, format, wcs->xposure);
    sprintf(comment, "[%s] Exposure (integration) time", timeunit);
    wcshdo_util(ctrl, "XPOSURE", "", 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      comment, nkeyrec, header, &status);
  }
d1089 9
a1097 6
  /* Elapsed time (start to stop). */
  if (!undefined(wcs->telapse)) {
    wcsutil_double2str(keyvalue, format, wcs->telapse);
    sprintf(comment, "[%s] Elapsed time (start to stop)", timeunit);
    wcshdo_util(ctrl, "TELAPSE", "", 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      comment, nkeyrec, header, &status);
d1100 3
a1102 1
  /* - - - - - - - - - - - - - - - - - - - - - - - - - - - Timing accuracy. */
d1104 8
a1111 7
  /* Systematic error in time measurements. */
  if (!undefined(wcs->timsyer)) {
    wcsutil_double2str(keyvalue, format, wcs->timsyer);
    sprintf(comment, "[%s] Systematic error in time measurements", timeunit);
    wcshdo_util(ctrl, "TIMSYER", "", 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      comment, nkeyrec, header, &status);
  }
d1113 2
a1114 123
  /* Relative error in time measurements. */
  if (!undefined(wcs->timrder)) {
    wcsutil_double2str(keyvalue, format, wcs->timrder);
    sprintf(comment, "[%s] Relative error in time measurements", timeunit);
    wcshdo_util(ctrl, "TIMRDER", "", 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      comment, nkeyrec, header, &status);
  }

  /* Time resolution. */
  if (!undefined(wcs->timedel)) {
    wcsutil_double2str(keyvalue, format, wcs->timedel);
    sprintf(comment, "[%s] Time resolution", timeunit);
    wcshdo_util(ctrl, "TIMEDEL", "", 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      comment, nkeyrec, header, &status);
  }

  /* Reference position of timestamp in binned data. */
  if (!undefined(wcs->timepixr)) {
    wcsutil_double2str(keyvalue, format, wcs->timepixr);
    wcshdo_util(ctrl, "TIMEPIXR", "", 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "Reference position of timestamp in binned data", nkeyrec, header,
      &status);
  }

  /* - - - - - - - - - - - - - - - - - Spatial & celestial reference frame. */

  /* Observatory coordinates. */
  if (!undefined(wcs->obsgeo[0]) &&
      !undefined(wcs->obsgeo[1]) &&
      !undefined(wcs->obsgeo[2])) {

    for (k = 0; k < 3; k++) {
      wcsutil_double2str(keyvalue, format, wcs->obsgeo[k]);
      sprintf(comment, "[m] observatory %c-coordinate", xyz[k]);
      obsgeo[7] = xyz[k];
      obsg[4]   = xyz[k];
      wcshdo_util(ctrl, obsgeo, obsg, 0, 0x0, 0, 0, 0, ' ',
        colnum, colax, keyvalue, comment, nkeyrec, header, &status);
    }

  } else if (
      !undefined(wcs->obsgeo[3]) &&
      !undefined(wcs->obsgeo[4]) &&
      !undefined(wcs->obsgeo[5])) {

    wcsutil_double2str(keyvalue, format, wcs->obsgeo[3]);
    wcshdo_util(ctrl, "OBSGEO-L", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "[deg] IAU(1976) observatory longitude", nkeyrec, header, &status);

    wcsutil_double2str(keyvalue, format, wcs->obsgeo[4]);
    wcshdo_util(ctrl, "OBSGEO-B", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "[deg] IAU(1976) observatory latitude", nkeyrec, header, &status);

    wcsutil_double2str(keyvalue, format, wcs->obsgeo[5]);
    wcshdo_util(ctrl, "OBSGEO-L", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "[m]   IAU(1976) observatory height", nkeyrec, header, &status);
  }

  /* Spacecraft orbit ephemeris file. */
  if (wcs->obsorbit[0]) {
    sprintf(keyvalue, "'%s'", wcs->obsorbit);
    wcshdo_util(ctrl, "OBSORBIT", 0x0, 0, 0x0, 0, 0, 0, ' ', 0, 0x0, keyvalue,
      "Spacecraft orbit ephemeris file", nkeyrec, header, &status);
  }

  /* Equatorial coordinate system type. */
  if (wcs->radesys[0]) {
    sprintf(keyvalue, "'%s'", wcs->radesys);
    wcshdo_util(ctrl, "RADESYS", "RADE", 0, 0x0, 0, 0, 0, alt, colnum, colax,
      keyvalue, "Equatorial coordinate system", nkeyrec, header, &status);
  }

  /* Equinox of equatorial coordinate system. */
  if (!undefined(wcs->equinox)) {
    wcsutil_double2str(keyvalue, format, wcs->equinox);
    wcshdo_util(ctrl, "EQUINOX", "EQUI", 0, 0x0, 0, 0, 0, alt, colnum, colax,
      keyvalue, "[yr] Equinox of equatorial coordinates", nkeyrec, header,
      &status);
  }

  /* Reference frame of spectral coordinates. */
  if (wcs->specsys[0]) {
    sprintf(keyvalue, "'%s'", wcs->specsys);
    wcshdo_util(ctrl, "SPECSYS", "SPEC", 0, 0x0, 0, 0, 0, alt, colnum, colax,
      keyvalue, "Reference frame of spectral coordinates", nkeyrec, header,
      &status);
  }

  /* Reference frame of spectral observation. */
  if (wcs->ssysobs[0]) {
    sprintf(keyvalue, "'%s'", wcs->ssysobs);
    wcshdo_util(ctrl, "SSYSOBS", "SOBS", 0, 0x0, 0, 0, 0, alt, colnum, colax,
      keyvalue, "Reference frame of spectral observation", nkeyrec, header,
      &status);
  }

  /* Observer's velocity towards source. */
  if (!undefined(wcs->velosys)) {
    wcsutil_double2str(keyvalue, format, wcs->velosys);
    wcshdo_util(ctrl, "VELOSYS", "VSYS", 0, 0x0, 0, 0, 0, alt, colnum, colax,
      keyvalue, "[m/s] Velocity towards source", nkeyrec, header, &status);
  }

  /* Redshift of the source. */
  if (!undefined(wcs->zsource)) {
    wcsutil_double2str(keyvalue, format, wcs->zsource);
    wcshdo_util(ctrl, "ZSOURCE", "ZSOU", 0, 0x0, 0, 0, 0, alt, colnum, colax,
      keyvalue, "Redshift of the source", nkeyrec, header, &status);
  }

  /* Reference frame of source redshift. */
  if (wcs->ssyssrc[0]) {
    sprintf(keyvalue, "'%s'", wcs->ssyssrc);
    wcshdo_util(ctrl, "SSYSSRC", "SSRC", 0, 0x0, 0, 0, 0, alt, colnum, colax,
      keyvalue, "Reference frame of source redshift", nkeyrec, header,
      &status);
  }

  /* Velocity orientation angle. */
  if (!undefined(wcs->velangl)) {
    wcsutil_double2str(keyvalue, format, wcs->velangl);
    wcshdo_util(ctrl, "VELANGL", "VANG", 0, 0x0, 0, 0, 0, alt, colnum, colax,
      keyvalue, "[deg] Velocity orientation angle", nkeyrec, header, &status);
@


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: wcshdr.c,v 5.18.1.3 2018/07/25 06:25:27 mcalabre Exp mcalabre $
d1131 1
a1131 1
        wcsutil_double2str(keyvalue, "%20.13E", wcsutil_dpkey_double(keyp));
d1170 1
a1170 1
        if ((keyval = wcsutil_dpkey_double(keyp)) == 0.0) continue;
d1221 1
a1221 1
        if ((keyval = wcsutil_dpkey_double(keyp)) == 0.0) continue;
d1270 1
a1270 1
          if ((keyval = wcsutil_dpkey_double(keyp)) == 0.0) continue;
d1515 1
a1515 1
            sprintf(keyvalue, "'%s: %d'", cp, wcsutil_dpkey_int(keyp));
d1524 1
a1524 1
              keyval = wcsutil_dpkey_double(keyp);
d1574 1
a1574 1
            sprintf(keyvalue, "'%s: %d'", cp, wcsutil_dpkey_int(keyp));
d1584 1
a1584 1
            if ((keyval = wcsutil_dpkey_double(keyp)) == 0.0) continue;
@


5.19.1.1
log
@WCSLIB 5.19 development branch.
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 5.19 2018/07/26 15:37:04 mcalabre Exp $
@


5.19.1.2
log
@wcsutil_dpkey_int() -> dpkeyi(), wcsutil_dpkey_double() -> dpkeyd().
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 5.19.1.1 2018/07/26 15:41:40 mcalabre Exp mcalabre $
d1131 1
a1131 1
        wcsutil_double2str(keyvalue, "%20.13E", dpkeyd(keyp));
d1170 1
a1170 1
        if ((keyval = dpkeyd(keyp)) == 0.0) continue;
d1221 1
a1221 1
        if ((keyval = dpkeyd(keyp)) == 0.0) continue;
d1270 1
a1270 1
          if ((keyval = dpkeyd(keyp)) == 0.0) continue;
d1515 1
a1515 1
            sprintf(keyvalue, "'%s: %d'", cp, dpkeyi(keyp));
d1524 1
a1524 1
              keyval = dpkeyd(keyp);
d1574 1
a1574 1
            sprintf(keyvalue, "'%s: %d'", cp, dpkeyi(keyp));
d1584 1
a1584 1
            if ((keyval = dpkeyd(keyp)) == 0.0) continue;
@


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: wcshdr.c,v 5.17.1.2 2018/01/10 08:25:34 mcalabre Exp mcalabre $
d507 1
a507 1
       keyvalue[72], keyword[16], *kp, *kp0, obsg[8] = "OBSG?",
d510 2
a511 2
  int  *axmap, bintab, col0, *colax, colnum, degree, direct, doaux, dofmt,
       dosip, dotpd, dotpv, i, idis, idp, *iparm, j, jhat, k, m, naxis,
d1138 1
a1138 1
      precision = kp - (keyvalue + 2);
d1782 1
a1782 1
  char ch0, ch1, *hptr, keyword[16], *kptr;
@


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


5.18.1.2
log
@In wcshdo(), increased the size of the sprintf() output buffer, keyvalue[],
to avert -Wformat-overflow warnings from gcc 8.1.0 (with -DFORTIFY_SOURCE=2).
Likewise in wcshdo_util() for keyword[].
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 5.18.1.1 2018/01/10 08:33:04 mcalabre Exp mcalabre $
d507 1
a507 1
       keyvalue[96], keyword[16], *kp, *kp0, obsg[8] = "OBSG?",
d1782 1
a1782 1
  char ch0, ch1, *hptr, keyword[32], *kptr;
@


5.18.1.3
log
@In wcshdo(), fixed a bug uncovered by 'gcc -Wmaybe-uninitialized', and avert
two other nuisance warnings about possible use of uninitialized variables.
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 5.18.1.2 2018/07/24 14:00:52 mcalabre Exp mcalabre $
d510 2
a511 2
  int  *axmap, bintab, col0, *colax, colnum, degree, direct = 0, doaux = 0,
       dofmt, dosip, dotpd, dotpv, i, idis, idp, *iparm, j, jhat, k, m, naxis,
d1138 1
a1138 1
      precision = kp0 - (keyvalue + 2);
@


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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.c,v 5.12.1.3 2016/01/26 08:12:58 mcalabre Exp mcalabre $
@


5.13.1.1
log
@WCSLIB 5.13 development branch.
@
text
@d25 1
a25 1
  $Id: wcshdr.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: wcshdr.c,v 5.11.1.2 2015/11/15 01:51:10 mcalabre Exp mcalabre $
d496 1
a496 1
int wcshdo(int relax, struct wcsprm *wcs, int *nkeyrec, char **header)
d506 1
a506 1
  char alt, comment[72], ctemp[32], *ctypei, format[8], fmt01[8],
d510 3
a512 3
  int  *axmap, bintab, col0, *colax, colnum, degree, direct, doaux, dosip,
       dotpd, dotpv, i, idis, idp, *iparm, j, jhat, k, m, naxis, ncoeff, Nhat,
       p, pixlist, precision, primage, q, status = 0;
d553 27
d583 1
a583 1
    wcshdo_util(relax, "WCSAXES", "WCAX", 0, 0x0, 0, 0, 0, alt, colnum, colax,
d588 1
a588 1
  wcshdo_format('G', naxis, wcs->crpix, format);
d591 1
a591 1
    wcshdo_util(relax, "CRPIX", "CRP", WCSHDO_CRPXna, "CRPX", 0, j+1, 0, alt,
d597 1
a597 1
  wcshdo_format('G', naxis*naxis, wcs->pc, format);
d608 1
a608 1
      wcshdo_util(relax, "PC", bintab ? "PC" : "P", WCSHDO_TPCn_ka,
d616 1
a616 1
  wcshdo_format('G', naxis, wcs->cdelt, format);
d622 1
a622 1
    wcshdo_util(relax, "CDELT", "CDE", WCSHDO_CRPXna, "CDLT", i+1, 0, 0, alt,
d631 1
a631 1
    wcshdo_util(relax, "CUNIT", "CUN", WCSHDO_CRPXna, "CUNI", i+1, 0, 0, alt,
d823 1
a823 1
    wcshdo_util(relax, "CTYPE", "CTY", WCSHDO_CRPXna, "CTYP", i+1, 0, 0, alt,
d829 1
a829 1
    wcshdo_format('G', 1, wcs->crval+i, format);
d834 1
a834 1
    wcshdo_util(relax, "CRVAL", "CRV", WCSHDO_CRPXna, "CRVL", i+1, 0, 0, alt,
d839 1
d841 1
a841 1
    wcsutil_double2str(keyvalue, "%20.12G", (wcs->pv[k]).value);
d877 1
a877 1
    wcshdo_util(relax, "PV", "V", WCSHDO_PVn_ma, "PV", wcs->pv[k].i, -1,
d884 1
a884 1
    wcshdo_util(relax, "PS", "S", WCSHDO_PVn_ma, "PS", wcs->ps[k].i, -1,
d892 2
a893 2
    wcsutil_double2str(keyvalue, "%20.12G", wcs->lonpole);
    wcshdo_util(relax, "LONPOLE", "LONP", 0, 0x0, 0, 0, 0, alt,
d899 2
a900 2
    wcsutil_double2str(keyvalue, "%20.12G", wcs->latpole);
    wcshdo_util(relax, "LATPOLE", "LATP", 0, 0x0, 0, 0, 0, alt,
d906 2
a907 2
    wcsutil_double2str(keyvalue, "%20.12G", wcs->restfrq);
    wcshdo_util(relax, "RESTFRQ", "RFRQ", 0, 0x0, 0, 0, 0, alt,
d913 2
a914 2
    wcsutil_double2str(keyvalue, "%20.12G", wcs->restwav);
    wcshdo_util(relax, "RESTWAV", "RWAV", 0, 0x0, 0, 0, 0, alt,
d923 1
a923 1
      wcshdo_util(relax, "WCSNAME", "WCSN", 0, 0x0, 0, 0, 0, alt,
d928 1
a928 1
      wcshdo_util(relax, "WCSNAME", "TWCS", WCSHDO_WCSNna, "WCSN", 0, 0, 0,
d940 1
a940 1
      wcshdo_util(relax, "CNAME", "CNA", WCSHDO_CNAMna, "CNAM", i+1, 0, 0,
d951 1
a951 1
      wcsutil_double2str(keyvalue, "%20.12G", wcs->crder[i]);
d955 1
a955 1
      wcshdo_util(relax, "CRDER", "CRD", WCSHDO_CNAMna, "CRDE", i+1, 0, 0,
d965 1
a965 1
      wcsutil_double2str(keyvalue, "%20.12G", wcs->csyer[i]);
d969 1
a969 1
      wcshdo_util(relax, "CSYER", "CSY", WCSHDO_CNAMna, "CSYE", i+1, 0, 0,
d977 1
a977 1
    wcshdo_util(relax, "RADESYS", "RADE", 0, 0x0, 0, 0, 0, alt,
d984 2
a985 2
    wcsutil_double2str(keyvalue, "%20.12G", wcs->equinox);
    wcshdo_util(relax, "EQUINOX", "EQUI", 0, 0x0, 0, 0, 0, alt,
d993 1
a993 1
    wcshdo_util(relax, "SPECSYS", "SPEC", 0, 0x0, 0, 0, 0, alt,
d1001 1
a1001 1
    wcshdo_util(relax, "SSYSOBS", "SOBS", 0, 0x0, 0, 0, 0, alt,
d1008 2
a1009 2
    wcsutil_double2str(keyvalue, "%20.12G", wcs->velosys);
    wcshdo_util(relax, "VELOSYS", "VSYS", 0, 0x0, 0, 0, 0, alt,
d1017 1
a1017 1
    wcshdo_util(relax, "SSYSSRC", "SSRC", 0, 0x0, 0, 0, 0, alt,
d1024 2
a1025 2
    wcsutil_double2str(keyvalue, "%20.12G", wcs->zsource);
    wcshdo_util(relax, "ZSOURCE", "ZSOU", 0, 0x0, 0, 0, 0, alt,
d1034 1
a1034 1
    wcsutil_double2str(keyvalue, "%20.12G", wcs->obsgeo[k]);
d1038 1
a1038 1
    wcshdo_util(relax, obsgeo, obsg, 0, 0x0, 0, 0, 0, ' ',
d1044 1
a1044 1
    wcsutil_double2str(keyvalue, "%20.12G", wcs->mjdobs);
d1048 1
a1048 1
      if (primage || (relax & 1) == 0) {
d1055 1
a1055 1
    wcshdo_util(relax, "MJD-OBS", "MJDOB", 0, 0x0, 0, 0, 0, ' ',
d1061 1
a1061 1
    wcsutil_double2str(keyvalue, "%20.12G", wcs->mjdavg);
d1072 1
a1072 1
    wcshdo_util(relax, "MJD-AVG", "MJDA", 0, 0x0, 0, 0, 0, ' ',
d1089 1
a1089 1
    if (relax & 1) {
d1091 1
a1091 1
      wcshdo_util(relax, "DATE-OBS", "DOBS", WCSHDO_DOBSn, 0x0, 0, 0, 0,
d1095 1
a1095 1
      wcshdo_util(relax, "DATE-OBS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0,
d1113 1
a1113 1
    wcshdo_util(relax, "DATE-AVG", "DAVG", 0, 0x0, 0, 0, 0, ' ',
d1124 19
a1142 17
    dis  = wcs->lin.dispre;
    keyp = dis->dp;
    kp0  = keyvalue + 2;
    for (idp = 0; idp < dis->ndp; idp++, keyp++) {
      cp = strchr(keyp->field, '.') + 1;
      if (strncmp(cp, "SIP.", 4) != 0) continue;
      wcsutil_double2str(keyvalue, "%20.13E", wcsutil_dpkey_double(keyp));

      kp = keyvalue + 15;
      while (kp0 < kp && *kp == '0') kp--;
      kp0 = kp;
    }

    precision = kp - (keyvalue + 2);
    if (precision < 1)  precision = 1;
    if (13 < precision) precision = 13;
    sprintf(format, "%%20.%dE", precision);
d1147 1
a1147 1
      wcshdo_util(relax, "", "", 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
d1164 1
a1164 1
      wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, ' ', 0, 0,
d1183 1
a1183 1
        wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, ' ', 0, 0,
d1190 1
a1190 1
        wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, ' ', 0, 0,
d1198 1
a1198 1
      wcshdo_util(relax, "", "", 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
d1215 1
a1215 1
      wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, ' ', 0, 0,
d1234 1
a1234 1
        wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, ' ', 0, 0,
d1257 1
a1257 1
        wcshdo_format('E', iparm[I_NDPARM], dparm, format);
d1260 1
a1260 1
        wcshdo_util(relax, "", "", 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
d1286 1
a1286 1
          wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1294 1
a1294 1
        wcshdo_util(relax, "", "", 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
d1341 1
a1341 1
        wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1354 1
a1354 1
        wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1381 1
a1381 1
          wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1386 1
a1386 1
        wcshdo_format('f', Nhat, dis->offset[j], format);
d1394 1
a1394 1
          wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1399 1
a1399 1
        wcshdo_format('f', Nhat, dis->scale[j], format);
d1407 1
a1407 1
          wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1413 1
a1413 1
          wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1423 1
a1423 1
          wcshdo_format('E', iparm[I_NDPARM], dparm, format);
d1445 1
a1445 1
              wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1468 1
a1468 1
            wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1478 1
a1478 1
            wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1485 1
a1485 1
          wcshdo_util(relax, "", "", 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
d1499 1
a1499 1
            wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1516 1
a1516 1
            wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1559 1
a1559 1
              wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1575 1
a1575 1
            wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1614 1
a1614 1
            wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1624 1
a1624 1
            wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1635 1
a1635 1
      wcshdo_util(relax, "DVERR", "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1642 1
a1642 1
  wcshdo_util(relax, "", "", 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
d1654 1
a1654 1
  wcshdo_util(relax, "COMMENT", "", 0, 0x0, 0, 0, 0, ' ', 0, 0,
@


5.12.1.1
log
@WCSLIB 5.12 development branch.
@
text
@d25 1
a25 1
  $Id: wcshdr.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: wcshdr.c,v 5.12.1.1 2015/11/15 02:16:14 mcalabre Exp mcalabre $
@


5.12.1.3
log
@In wcshdo(), provide floating-point format control via the 'ctrl'
argument (formerly 'relax').
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 5.12.1.2 2016/01/25 05:17:04 mcalabre Exp mcalabre $
d496 1
a496 1
int wcshdo(int ctrl, struct wcsprm *wcs, int *nkeyrec, char **header)
d506 1
a506 1
  char alt, comment[72], ctemp[32], *ctypei, format[16], fmt01[8],
d510 3
a512 3
  int  *axmap, bintab, col0, *colax, colnum, degree, direct, doaux, dofmt,
       dosip, dotpd, dotpv, i, idis, idp, *iparm, j, jhat, k, m, naxis,
       ncoeff, Nhat, p, pixlist, precision, primage, q, status = 0;
a552 27
  /* Initialize floating point format control. */
  *format = '\0';
  if (ctrl & WCSHDO_P17) {
    strcpy(format, "% 20.17G");
  } else if (ctrl & WCSHDO_P16) {
    strcpy(format, "% 20.16G");
  } else if (ctrl & WCSHDO_P15) {
    strcpy(format, "% 20.15G");
  } else if (ctrl & WCSHDO_P14) {
    strcpy(format, "% 20.14G");
  } else if (ctrl & WCSHDO_P13) {
    strcpy(format, "% 20.13G");
  } else if (ctrl & WCSHDO_P12) {
    strcpy(format, "%20.12G");
  }

  if (*format && (ctrl & WCSHDO_EFMT)) {
    if (format[6] == 'G') {
      format[6] = 'E';
    } else {
      format[7] = 'E';
    }
  }

  dofmt = (*format == '\0');


d556 1
a556 1
    wcshdo_util(ctrl, "WCSAXES", "WCAX", 0, 0x0, 0, 0, 0, alt, colnum, colax,
d561 1
a561 1
  if (dofmt) wcshdo_format('G', naxis, wcs->crpix, format);
d564 1
a564 1
    wcshdo_util(ctrl, "CRPIX", "CRP", WCSHDO_CRPXna, "CRPX", 0, j+1, 0, alt,
d570 1
a570 1
  if (dofmt) wcshdo_format('G', naxis*naxis, wcs->pc, format);
d581 1
a581 1
      wcshdo_util(ctrl, "PC", bintab ? "PC" : "P", WCSHDO_TPCn_ka,
d589 1
a589 1
  if (dofmt) wcshdo_format('G', naxis, wcs->cdelt, format);
d595 1
a595 1
    wcshdo_util(ctrl, "CDELT", "CDE", WCSHDO_CRPXna, "CDLT", i+1, 0, 0, alt,
d604 1
a604 1
    wcshdo_util(ctrl, "CUNIT", "CUN", WCSHDO_CRPXna, "CUNI", i+1, 0, 0, alt,
d796 1
a796 1
    wcshdo_util(ctrl, "CTYPE", "CTY", WCSHDO_CRPXna, "CTYP", i+1, 0, 0, alt,
d802 1
a802 1
    if (dofmt) wcshdo_format('G', 1, wcs->crval+i, format);
d807 1
a807 1
    wcshdo_util(ctrl, "CRVAL", "CRV", WCSHDO_CRPXna, "CRVL", i+1, 0, 0, alt,
a811 1
  if (dofmt) strcpy(format, "%20.12G");
d813 1
a813 1
    wcsutil_double2str(keyvalue, format, (wcs->pv[k]).value);
d849 1
a849 1
    wcshdo_util(ctrl, "PV", "V", WCSHDO_PVn_ma, "PV", wcs->pv[k].i, -1,
d856 1
a856 1
    wcshdo_util(ctrl, "PS", "S", WCSHDO_PVn_ma, "PS", wcs->ps[k].i, -1,
d864 2
a865 2
    wcsutil_double2str(keyvalue, format, wcs->lonpole);
    wcshdo_util(ctrl, "LONPOLE", "LONP", 0, 0x0, 0, 0, 0, alt,
d871 2
a872 2
    wcsutil_double2str(keyvalue, format, wcs->latpole);
    wcshdo_util(ctrl, "LATPOLE", "LATP", 0, 0x0, 0, 0, 0, alt,
d878 2
a879 2
    wcsutil_double2str(keyvalue, format, wcs->restfrq);
    wcshdo_util(ctrl, "RESTFRQ", "RFRQ", 0, 0x0, 0, 0, 0, alt,
d885 2
a886 2
    wcsutil_double2str(keyvalue, format, wcs->restwav);
    wcshdo_util(ctrl, "RESTWAV", "RWAV", 0, 0x0, 0, 0, 0, alt,
d895 1
a895 1
      wcshdo_util(ctrl, "WCSNAME", "WCSN", 0, 0x0, 0, 0, 0, alt,
d900 1
a900 1
      wcshdo_util(ctrl, "WCSNAME", "TWCS", WCSHDO_WCSNna, "WCSN", 0, 0, 0,
d912 1
a912 1
      wcshdo_util(ctrl, "CNAME", "CNA", WCSHDO_CNAMna, "CNAM", i+1, 0, 0,
d923 1
a923 1
      wcsutil_double2str(keyvalue, format, wcs->crder[i]);
d927 1
a927 1
      wcshdo_util(ctrl, "CRDER", "CRD", WCSHDO_CNAMna, "CRDE", i+1, 0, 0,
d937 1
a937 1
      wcsutil_double2str(keyvalue, format, wcs->csyer[i]);
d941 1
a941 1
      wcshdo_util(ctrl, "CSYER", "CSY", WCSHDO_CNAMna, "CSYE", i+1, 0, 0,
d949 1
a949 1
    wcshdo_util(ctrl, "RADESYS", "RADE", 0, 0x0, 0, 0, 0, alt,
d956 2
a957 2
    wcsutil_double2str(keyvalue, format, wcs->equinox);
    wcshdo_util(ctrl, "EQUINOX", "EQUI", 0, 0x0, 0, 0, 0, alt,
d965 1
a965 1
    wcshdo_util(ctrl, "SPECSYS", "SPEC", 0, 0x0, 0, 0, 0, alt,
d973 1
a973 1
    wcshdo_util(ctrl, "SSYSOBS", "SOBS", 0, 0x0, 0, 0, 0, alt,
d980 2
a981 2
    wcsutil_double2str(keyvalue, format, wcs->velosys);
    wcshdo_util(ctrl, "VELOSYS", "VSYS", 0, 0x0, 0, 0, 0, alt,
d989 1
a989 1
    wcshdo_util(ctrl, "SSYSSRC", "SSRC", 0, 0x0, 0, 0, 0, alt,
d996 2
a997 2
    wcsutil_double2str(keyvalue, format, wcs->zsource);
    wcshdo_util(ctrl, "ZSOURCE", "ZSOU", 0, 0x0, 0, 0, 0, alt,
d1006 1
a1006 1
    wcsutil_double2str(keyvalue, format, wcs->obsgeo[k]);
d1010 1
a1010 1
    wcshdo_util(ctrl, obsgeo, obsg, 0, 0x0, 0, 0, 0, ' ',
d1016 1
a1016 1
    wcsutil_double2str(keyvalue, format, wcs->mjdobs);
d1020 1
a1020 1
      if (primage || (ctrl & 1) == 0) {
d1027 1
a1027 1
    wcshdo_util(ctrl, "MJD-OBS", "MJDOB", 0, 0x0, 0, 0, 0, ' ',
d1033 1
a1033 1
    wcsutil_double2str(keyvalue, format, wcs->mjdavg);
d1044 1
a1044 1
    wcshdo_util(ctrl, "MJD-AVG", "MJDA", 0, 0x0, 0, 0, 0, ' ',
d1061 1
a1061 1
    if (ctrl & 1) {
d1063 1
a1063 1
      wcshdo_util(ctrl, "DATE-OBS", "DOBS", WCSHDO_DOBSn, 0x0, 0, 0, 0,
d1067 1
a1067 1
      wcshdo_util(ctrl, "DATE-OBS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0,
d1085 1
a1085 1
    wcshdo_util(ctrl, "DATE-AVG", "DAVG", 0, 0x0, 0, 0, 0, ' ',
d1096 17
a1112 19
    dis = wcs->lin.dispre;
    if (dofmt) {
      keyp = dis->dp;
      kp0  = keyvalue + 2;
      for (idp = 0; idp < dis->ndp; idp++, keyp++) {
        cp = strchr(keyp->field, '.') + 1;
        if (strncmp(cp, "SIP.", 4) != 0) continue;
        wcsutil_double2str(keyvalue, "%20.13E", wcsutil_dpkey_double(keyp));

        kp = keyvalue + 15;
        while (kp0 < kp && *kp == '0') kp--;
        kp0 = kp;
      }

      precision = kp - (keyvalue + 2);
      if (precision < 1)  precision = 1;
      if (13 < precision) precision = 13;
      sprintf(format, "%%20.%dE", precision);
    }
d1117 1
a1117 1
      wcshdo_util(ctrl, "", "", 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
d1134 1
a1134 1
      wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, ' ', 0, 0,
d1153 1
a1153 1
        wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, ' ', 0, 0,
d1160 1
a1160 1
        wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, ' ', 0, 0,
d1168 1
a1168 1
      wcshdo_util(ctrl, "", "", 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
d1185 1
a1185 1
      wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, ' ', 0, 0,
d1204 1
a1204 1
        wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, ' ', 0, 0,
d1227 1
a1227 1
        if (dofmt) wcshdo_format('E', iparm[I_NDPARM], dparm, format);
d1230 1
a1230 1
        wcshdo_util(ctrl, "", "", 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
d1256 1
a1256 1
          wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1264 1
a1264 1
        wcshdo_util(ctrl, "", "", 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
d1311 1
a1311 1
        wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1324 1
a1324 1
        wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1351 1
a1351 1
          wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1356 1
a1356 1
        if (dofmt) wcshdo_format('f', Nhat, dis->offset[j], format);
d1364 1
a1364 1
          wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1369 1
a1369 1
        if (dofmt) wcshdo_format('f', Nhat, dis->scale[j], format);
d1377 1
a1377 1
          wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1383 1
a1383 1
          wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1393 1
a1393 1
          if (dofmt) wcshdo_format('E', iparm[I_NDPARM], dparm, format);
d1415 1
a1415 1
              wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1438 1
a1438 1
            wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1448 1
a1448 1
            wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1455 1
a1455 1
          wcshdo_util(ctrl, "", "", 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
d1469 1
a1469 1
            wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1486 1
a1486 1
            wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1529 1
a1529 1
              wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1545 1
a1545 1
            wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1584 1
a1584 1
            wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1594 1
a1594 1
            wcshdo_util(ctrl, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1605 1
a1605 1
      wcshdo_util(ctrl, "DVERR", "", 0, 0x0, 0, 0, 0, alt, 0, 0,
d1612 1
a1612 1
  wcshdo_util(ctrl, "", "", 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
d1624 1
a1624 1
  wcshdo_util(ctrl, "COMMENT", "", 0, 0x0, 0, 0, 0, ' ', 0, 0,
@


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: wcshdr.c,v 5.10.1.1 2015/10/09 08:22:35 mcalabre Exp mcalabre $
a800 1
  wcshdo_format('G', naxis, wcs->crval, format);
d802 1
@


5.11.1.1
log
@WCSLIB 5.11 development branch.
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 5.11 2015/10/18 09:13:05 mcalabre Exp $
@


5.11.1.2
log
@Bug fix in wcshdo() for CRVALia precision reported by Mihai Cara.
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 5.11.1.1 2015/10/18 09:16:27 mcalabre Exp mcalabre $
d801 1
a802 1
    wcshdo_format('G', 1, wcs->crval+i, format);
@


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: wcshdr.c,v 5.9.1.2 2015/08/02 07:49:06 mcalabre Exp mcalabre $
@


5.10.1.1
log
@WCSLIB 5.10 development branch.
@
text
@d25 1
a25 1
  $Id: wcshdr.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: wcshdr.c,v 5.8.1.2 2015/07/21 08:39:02 mcalabre Exp mcalabre $
d491 4
a494 3
#define I_TPDNCO  4	/* No. of TPD coefficients.                         */
#define I_TPDAUX  5	/* True if auxiliary variables are used.            */
#define I_TPDRAD  6	/* True if the radial variable is used.             */
d506 4
a509 3
  char alt, comment[72], ctemp[32], *ctypei, format[8], keyvalue[72],
       keyword[16], *kp, *kp0, obsg[8] = "OBSG?", obsgeo[8] = "OBSGEO-?", pq,
       ptype, xtype, term[16], tpdsrc[24], xyz[] = "XYZ";
d1228 1
d1252 1
a1252 1
            strcpy(keyvalue, "                 1.0");
d1394 1
d1400 1
a1400 1
                strcpy(ctemp, "                 0.0");
d1402 1
a1402 1
                strcpy(ctemp, "                 1.0");
d1428 1
a1428 1
              strcpy(ctemp, "                 1.0");
d1660 3
a1662 1
    wcsutil_double2str(cval, "%20.13E", val[i]);
d1664 1
a1664 1
    cp = cval + 15;
d1668 1
a1668 1
    sscanf(cval+17, "%d", &expon);
d1672 1
a1672 1
  nsig = cp - (cval + 2) + 1;
d1684 6
a1689 2
    if (13 < precision) precision = 13;
    sprintf(format, "%%20.%dE", precision);
@


5.9.1.1
log
@WCSLIB 5.9 development branch.
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 5.9 2015/07/21 09:20:01 mcalabre Exp $
@


5.9.1.2
log
@In wcshdo(), fixed a bug - I_TPDAUX changed in dis.c at version 5.8.1.2.
Also allow output of floating point keyvalues to 15 significant digits (was
14), with related changes required to keep the output header looking pretty.
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 5.9.1.1 2015/07/21 09:28:07 mcalabre Exp mcalabre $
d491 3
a493 4
#define I_TPDNCO  4	/* No. of TPD coefficients, forward...              */
#define I_TPDINV  5     /* ...and inverse.                                  */
#define I_TPDAUX  6	/* True if auxiliary variables are used.            */
#define I_TPDRAD  7	/* True if the radial variable is used.             */
d505 3
a507 4
  char alt, comment[72], ctemp[32], *ctypei, format[8], fmt01[8],
       keyvalue[72], keyword[16], *kp, *kp0, obsg[8] = "OBSG?",
       obsgeo[8] = "OBSGEO-?", pq, ptype, xtype, term[16], tpdsrc[24],
       xyz[] = "XYZ";
a1225 1
        sprintf(fmt01, "%.3ss", format);
d1249 1
a1249 1
            sprintf(keyvalue, fmt01, "1.0");
a1390 1
          sprintf(fmt01, "%.3ss", format);
d1396 1
a1396 1
                sprintf(ctemp, fmt01, "0.0");
d1398 1
a1398 1
                sprintf(ctemp, fmt01, "1.0");
d1424 1
a1424 1
              sprintf(ctemp, fmt01, "1.0");
d1656 1
a1656 3
    /* Double precision has at least 15 significant digits, and up to 17:  */
    /* http://en.wikipedia.org/wiki/Double-precision_floating-point_format */
    wcsutil_double2str(cval, "%21.14E", val[i]);
d1658 1
a1658 1
    cp = cval + 16;
d1662 1
a1662 1
    sscanf(cval+18, "%d", &expon);
d1666 1
a1666 1
  nsig = cp0 - (cval + 2) + 1;
d1678 2
a1679 6
    if (14 < precision) precision = 14;
    if (precision < 14) {
      sprintf(format, "%%20.%dE", precision);
    } else {
      sprintf(format, "%%21.%dE", precision);
    }
@


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: wcshdr.c,v 5.7.1.5 2015/07/08 10:16:51 mcalabre Exp mcalabre $
d29 1
d506 2
a507 2
       keyword[16], *kp, obsg[8] = "OBSG?", obsgeo[8] = "OBSGEO-?", pq, ptype,
       xtype, term[16], tpdsrc[24], xyz[] = "XYZ";
d559 1
d561 1
a561 1
    wcsutil_double2str(keyvalue, "%20.12G", wcs->crpix[j]);
d568 1
d578 1
a578 1
      wcsutil_double2str(keyvalue, "%20.12G", wcs->pc[k]);
d587 1
d589 1
a589 1
    wcsutil_double2str(keyvalue, "%20.12G", wcs->cdelt[i]);
d799 1
d801 1
a801 1
    wcsutil_double2str(keyvalue, "%20.12G", wcs->crval[i]);
d1094 1
a1094 1
    dis = wcs->lin.dispre;
d1096 1
a1096 1
    kp = keyvalue + 3;
d1101 4
a1104 1
      while (*kp != '0' && *kp != 'E') kp++;
d1107 1
a1107 1
    precision = kp - keyvalue - 3;
d1131 1
a1131 1
      sprintf(comment, "SIP polynomial degree, axis %d, pixel-to-sky", j);
d1155 7
a1161 5
      strcpy(keyword+2, "MAX");
      wcsutil_double2str(keyvalue, "%20.3f", dis->maxdis[j]);
      wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, ' ', 0, 0,
        keyvalue, "Maximum value of distortion function", nkeyrec,
        header, &status);
d1608 2
a1609 2
  wcshdo_util(relax, "", "", 0, 0x0, 0, 0, 0, alt, 0, 0,
    keyvalue, comment, nkeyrec, header, &status);
d1620 2
a1621 2
  wcshdo_util(relax, "COMMENT", "", 0, 0x0, 0, 0, 0, alt, 0, 0,
    keyvalue, comment, nkeyrec, header, &status);
d1640 2
a1641 2
  char *cp, cval[24];
  int  i, j, nblank, precision;
d1643 2
a1644 3
  if (fmt == 'f') {
    nblank = 8;
    cp = cval + 10;
d1646 15
a1660 1
      wcsutil_double2str(cval, "%20.10f", val[i]);
d1662 5
a1666 6
      for (j = 0; j <= nblank; j++) {
        if (cval[j] != ' ') {
          if (j < nblank) nblank = j;
          break;
        }
      }
a1667 2
      while (*cp && *cp != '0') cp++;
    }
d1669 2
a1670 1
    precision = cp - (cval + 10);
d1672 2
a1673 1
    sprintf(format, "%%%d.%df", (10-nblank)+precision, precision);
d1676 1
a1676 7
    cp = cval + 3;
    for (i = 0; i < nval; i++) {
      wcsutil_double2str(cval, "%20.13E", val[i]);
      while (*cp != '0' && *cp != 'E') cp++;
    }

    precision = cp - cval - 3;
@


5.8.1.1
log
@WCSLIB 5.8 development branch.
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 5.8 2015/07/08 11:03:59 mcalabre Exp $
@


5.8.1.2
log
@Bug fixes in wcshdo_format() and wcshdo() relating to the determination of
the appropriate precision.  wcshdo_format() now implements "G" formatting,
and wcshdo() uses it for CRPIXja, PCi_ja, CDELTia, and CRVALia.  Two bug
fixes in wcshdo() for writing SIP keywords, and a further two for identifying
WCSLIB as the author.
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 5.8.1.1 2015/07/08 11:07:18 mcalabre Exp mcalabre $
a28 1
#include <math.h>
d505 2
a506 2
       keyword[16], *kp, *kp0, obsg[8] = "OBSG?", obsgeo[8] = "OBSGEO-?", pq,
       ptype, xtype, term[16], tpdsrc[24], xyz[] = "XYZ";
a557 1
  wcshdo_format('G', naxis, wcs->crpix, format);
d559 1
a559 1
    wcsutil_double2str(keyvalue, format, wcs->crpix[j]);
a565 1
  wcshdo_format('G', naxis*naxis, wcs->pc, format);
d575 1
a575 1
      wcsutil_double2str(keyvalue, format, wcs->pc[k]);
a583 1
  wcshdo_format('G', naxis, wcs->cdelt, format);
d585 1
a585 1
    wcsutil_double2str(keyvalue, format, wcs->cdelt[i]);
a794 1
  wcshdo_format('G', naxis, wcs->crval, format);
d796 1
a796 1
    wcsutil_double2str(keyvalue, format, wcs->crval[i]);
d1089 1
a1089 1
    dis  = wcs->lin.dispre;
d1091 1
a1091 1
    kp0  = keyvalue + 2;
d1096 1
a1096 4

      kp = keyvalue + 15;
      while (kp0 < kp && *kp == '0') kp--;
      kp0 = kp;
d1099 1
a1099 1
    precision = kp - (keyvalue + 2);
d1123 1
a1123 1
      sprintf(comment, "SIP polynomial degree, axis %d, pixel-to-sky", j+1);
d1147 5
a1151 7
      if (dis->maxdis[j] != 0.0) {
        strcpy(keyword+2, "DMAX");
        wcsutil_double2str(keyvalue, "%20.3f", dis->maxdis[j]);
        wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, ' ', 0, 0,
          keyvalue, "Maximum value of distortion function", nkeyrec,
          header, &status);
      }
d1598 2
a1599 2
  wcshdo_util(relax, "", "", 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
    nkeyrec, header, &status);
d1610 2
a1611 2
  wcshdo_util(relax, "COMMENT", "", 0, 0x0, 0, 0, 0, ' ', 0, 0,
    "", comment, nkeyrec, header, &status);
d1630 2
a1631 2
  char *cp, *cp0, cval[24];
  int  i, expmax, expon, nsig, precision;
d1633 3
a1635 2
  if (fmt == 'G') {
    fmt = 'f';
d1637 7
a1643 3
      if (fabs(val[i]) < 1e-4 || 1e12 < val[i]) {
        fmt = 'E';
        break;
d1645 2
a1647 1
  }
d1649 1
a1649 18
  cp0 = cval + 2;
  expmax = -999;
  for (i = 0; i < nval; i++) {
    wcsutil_double2str(cval, "%20.13E", val[i]);

    cp = cval + 15;
    while (cp0 < cp && *cp == '0') cp--;
    cp0 = cp;

    sscanf(cval+17, "%d", &expon);
    if (expmax < expon) expmax = expon;
  }

  nsig = cp - (cval + 2) + 1;


  if (fmt == 'f') {
    precision = nsig - (expmax + 1);
d1651 1
a1651 2
    if (17 < precision) precision = 17;
    sprintf(format, "%%20.%df", precision);
d1654 7
a1660 1
    precision = nsig - 1;
@


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: wcshdr.c,v 5.6.1.4 2015/06/28 14:49:35 mcalabre Exp mcalabre $
d43 2
d67 1
d486 7
d501 2
a502 1
  const int nTPD[] = {1, 4, 7, 12, 17, 24, 31, 40, 49, 60};
d504 1
a504 1
  char alt, comment[72], ctemp[32], *ctypei, format[8], *fp, keyvalue[72],
d506 4
a509 4
       xtype, term[16], xyz[] = "XYZ";
  int  *axmap, bintab, col0, *colax, colnum, degree, direct, dosip, dotpd,
       dotpv, i, idis, idp, *iparm, j, jhat, k, m, naxis, ncoeff, Nhat, p,
       pixlist, precision, primage, q, status = 0;
d603 3
a605 1
  /* May need to alter ctype for particular distortions so do basic checks. */
d608 2
d613 29
a641 2
        /* Simple Imaging Polynomial (SIP). */
        dosip = 1;
d643 5
a647 21
        if (alt ||
            dis->axmap[0][0]  != 0 ||
            dis->axmap[0][1]  != 1 ||
            dis->axmap[1][0]  != 0 ||
            dis->axmap[1][1]  != 1 ||
            dis->offset[0][0] != wcs->crpix[0] ||
            dis->offset[0][1] != wcs->crpix[1] ||
            dis->offset[1][0] != wcs->crpix[0] ||
            dis->offset[1][1] != wcs->crpix[1] ||
            dis->scale[0][0]  != 1.0 ||
            dis->scale[0][1]  != 1.0 ||
            dis->scale[1][0]  != 1.0 ||
            dis->scale[1][1]  != 1.0) {
          /* Must have been read as a 'SIP' distortion, CPDISja = 'SIP'. */
          /* Can't be written as native SIP so write it as TPD.          */
          dosip = 2;
        } else if (strncmp(wcs->ctype[0], "RA---TAN", 8) ||
                   strncmp(wcs->ctype[1], "DEC--TAN", 8)) {
          /* Must have been permuted by wcssub(). */
          /* Native SIP doesn't have axis mapping so write it as TPD. */
          dosip = 2;
d658 30
a687 2
        /* TPV "projection". */
        dotpv = 1;
d689 14
a702 15
        if (dis->axmap[wcs->lng][0] != wcs->lng ||
            dis->axmap[wcs->lng][1] != wcs->lat ||
            dis->axmap[wcs->lat][0] != wcs->lat ||
            dis->axmap[wcs->lat][1] != wcs->lng ||
            dis->offset[wcs->lng][wcs->lng] != 0.0 ||
            dis->offset[wcs->lng][wcs->lat] != 0.0 ||
            dis->offset[wcs->lat][wcs->lng] != 0.0 ||
            dis->offset[wcs->lat][wcs->lat] != 0.0 ||
            dis->scale[wcs->lng][wcs->lng]  != 1.0 ||
            dis->scale[wcs->lng][wcs->lat]  != 1.0 ||
            dis->scale[wcs->lat][wcs->lng]  != 1.0 ||
            dis->scale[wcs->lat][wcs->lat]  != 1.0) {
          /* Must have been read as a 'TPV' distortion, CPDISja = 'TPV'. */
          /* Can't be written as native TPV so write it as TPD.          */
          dotpv = 2;
d720 1
a720 1
      if (dosip == 1) {
d723 1
a723 1
      } else if (dotpv == 1) {
d725 1
a725 1
        strcpy(ctypei+4, "-TPV");
d1083 2
a1084 3
  /* As far as possible, write distortion functions in the form of the */
  /* convention recorded in disprm::dtype.                             */
  if (dosip == 1) {
d1093 2
a1094 2
      fp = strpbrk(keyp->field, ".") + 1;
      if (strncmp(fp, "SIP.", 4) != 0) continue;
d1116 1
a1116 1
      ncoeff = dis->iparm[j][3];
d1132 5
a1136 5
        fp = strpbrk(keyp->field, ".") + 1;
        if (strncmp(fp, "SIP.FWD.", 8) != 0) continue;
        fp += 8;
        strcpy(keyword+2, fp);
        sscanf(fp, "%d_%d", &p, &q);
d1165 1
a1165 1
      ncoeff = dis->iparm[j][2] - dis->iparm[j][3];
d1181 5
a1185 5
        fp = strpbrk(keyp->field, ".") + 1;
        if (strncmp(fp, "SIP.REV.", 8) != 0) continue;
        fp += 8;
        strcpy(keyword+3, fp);
        sscanf(fp, "%d_%d", &p, &q);
a1197 1

d1205 3
d1209 1
a1209 1
      if (strcmp(dis->dtype[j], "TPV") == 0 && dotpv == 1) {
d1215 1
a1215 1
        wcshdo_format('E', dis->iparm[j][2], dis->dparm[j], format);
d1229 3
a1231 3
          fp = strpbrk(keyp->field, ".") + 1;
          if (strncmp(fp, "TPV.", 4) != 0) continue;
          strcpy(kp, fp+4);
d1234 1
a1234 1
          sscanf(fp+4, "%d", &m);
d1247 1
a1247 2
      } else if (strcmp(dis->dtype[j], "TPD") == 0 ||
                 dosip == 2 || dotpv == 2 ||
d1254 8
a1261 1
        dotpd = strncmp(dis->dtype[j], "Polynomial", 10);
d1281 1
d1331 5
a1335 5
            if (jhat == 0) {
              sprintf(comment+strlen(comment), " (= %c)", direct?'x':'y');
            } else {
              sprintf(comment+strlen(comment), " (= %c)", direct?'y':'x');
            }
d1368 7
d1376 33
a1408 3
          /* Template Polynomial Distortion.  As it may have been translated */
          /* from SIP, TPV, or perhaps Polynomial, the dpkey records may not */
          /* relate to TPD.  Output is therefore handled via dparm.          */
d1410 1
a1410 4
          iparm = dis->iparm[j];
          dparm = dis->dparm[j];
          wcshdo_format('E', iparm[2], dparm, format);
          for (idp = 0; idp < iparm[3]; idp++) {
d1418 1
d1446 1
a1446 1
          for (idp = iparm[3]; idp < iparm[2]; idp++) {
d1450 1
a1450 1
            m = idp - iparm[3];
d1468 2
a1469 2
            fp = strpbrk(keyp->field, ".") + 1;
            if (strncmp(fp, "NAUX", 4) != 0) continue;
d1471 1
a1471 1
            sprintf(keyvalue, "'%s: %d'", fp, wcsutil_dpkey_int(keyp));
d1482 2
a1483 2
              fp = strpbrk(keyp->field, ".") + 1;
              if (strncmp(fp, "AUX.", 4) != 0) continue;
d1485 2
a1486 2
              sscanf(fp+4, "%d", &m);
              sprintf(keyvalue, "'%s:", fp);
d1488 1
a1488 1
              fp = strpbrk(fp+4, ".") + 1;
d1500 2
a1501 2
              sscanf(fp+6, "%d", &p);
              if (strncmp(fp, "POWER.", 4) == 0) {
d1527 2
a1528 2
            fp = strpbrk(keyp->field, ".") + 1;
            if (strncmp(fp, "NTERMS", 6) != 0) continue;
d1530 1
a1530 1
            sprintf(keyvalue, "'%s: %d'", fp, wcsutil_dpkey_int(keyp));
d1542 2
a1543 2
            fp = strpbrk(keyp->field, ".") + 1;
            if (strncmp(fp, "TERM.", 5) != 0) continue;
d1545 2
a1546 2
            sscanf(fp+5, "%d", &m);
            sprintf(keyvalue, "'%s:%s ", fp, (m<10)?" ":"");
d1548 1
a1548 1
            fp = strpbrk(fp+5, ".") + 1;
d1550 1
a1550 1
            if (strncmp(fp, "VAR.", 4) == 0) {
d1557 1
a1557 1
              sscanf(fp+4, "%d", &p);
d1594 2
d1597 11
d1609 3
@


5.7.1.1
log
@WCSLIB 5.7 development branch.
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 5.7 2015/06/29 02:44:16 mcalabre Exp $
@


5.7.1.2
log
@Bug fix in wcshdo() for TPV, diagnosed by Michael Droettboom.
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 5.7.1.1 2015/06/29 02:47:24 mcalabre Exp mcalabre $
d672 1
a672 1
        strcpy(ctypei+4, "-TPV'");
@


5.7.1.3
log
@In wcshdo(), reworked the handling of the dotpd, dosip, and dotpv variables,
and added support for dishdo(), and for writing DSS, TNX, and ZPX as TPD.
Also identify that the WCS keyrecords were written by WCSLIB.
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 5.7.1.2 2015/06/30 06:04:29 mcalabre Exp mcalabre $
a42 2
extern const int DIS_DOTPD;

d495 1
a495 1
       xtype, term[16], tpdsrc[24], xyz[] = "XYZ";
d592 1
a592 3
  /* May need to alter ctype for particular distortions so do basic checks */
  /* now.  Note that SIP, TPV, DSS, TNX, and ZPX are restricted to exactly */
  /* two axes and cannot coexist with other distortion types.              */
a594 2
  dotpd = 0;

d598 2
a599 29
        /* Simple Imaging Polynomial (SIP).  Write it in its native form  */
        /* if possible, unless specifically requested to write it as TPD. */
        dotpd = (dis->iparm[i][0] & DIS_DOTPD);

        if (!dotpd) {;
          if (alt ||
              dis->Nhat[0]      != 2 ||
              dis->Nhat[1]      != 2 ||
              dis->axmap[0][0]  != 0 ||
              dis->axmap[0][1]  != 1 ||
              dis->axmap[1][0]  != 0 ||
              dis->axmap[1][1]  != 1 ||
              dis->offset[0][0] != wcs->crpix[0] ||
              dis->offset[0][1] != wcs->crpix[1] ||
              dis->offset[1][0] != wcs->crpix[0] ||
              dis->offset[1][1] != wcs->crpix[1] ||
              dis->scale[0][0]  != 1.0 ||
              dis->scale[0][1]  != 1.0 ||
              dis->scale[1][0]  != 1.0 ||
              dis->scale[1][1]  != 1.0) {
            /* Must have been read as a 'SIP' distortion, CPDISja = 'SIP'. */
            /* Cannot be written as native SIP so write it as TPD.         */
            dotpd = DIS_DOTPD;
          } else if (strncmp(wcs->ctype[0], "RA---TAN", 8) ||
                     strncmp(wcs->ctype[1], "DEC--TAN", 8)) {
            /* Must have been permuted by wcssub(). */
            /* Native SIP doesn't have axis mapping so write it as TPD. */
            dotpd = DIS_DOTPD;
          }
d601 21
a621 5
          if (dotpd) {
            strcpy(tpdsrc, "SIP coordinates");
          } else {
            dosip = 1;
          }
d632 2
a633 30
        /* TPV "projection".  Write it in its native form if possible, */
        /* unless specifically requested to write it as TPD.           */
        dotpd = (dis->iparm[i][0] & DIS_DOTPD);

        if (!dotpd) {;
          if (dis->axmap[wcs->lng][0] != wcs->lng ||
              dis->axmap[wcs->lng][1] != wcs->lat ||
              dis->axmap[wcs->lat][0] != wcs->lat ||
              dis->axmap[wcs->lat][1] != wcs->lng ||
              dis->offset[wcs->lng][wcs->lng] != 0.0 ||
              dis->offset[wcs->lng][wcs->lat] != 0.0 ||
              dis->offset[wcs->lat][wcs->lng] != 0.0 ||
              dis->offset[wcs->lat][wcs->lat] != 0.0 ||
              dis->scale[wcs->lng][wcs->lng]  != 1.0 ||
              dis->scale[wcs->lng][wcs->lat]  != 1.0 ||
              dis->scale[wcs->lat][wcs->lng]  != 1.0 ||
              dis->scale[wcs->lat][wcs->lat]  != 1.0) {
            /* Must have been read as a 'TPV' distortion, CPDISja = 'TPV'. */
            /* Cannot be written as native TPV so write it as TPD.         */
            dotpd = DIS_DOTPD;
          }

          if (dotpd) {
            strcpy(tpdsrc, "TPV \"projection\"");
          } else {
            dotpv = 1;
          }
        }

        break;
d635 15
a649 11
      } else if (strcmp(dis->dtype[i], "DSS") == 0 ||
                 strcmp(dis->dtype[i], "TNX") == 0 ||
                 strcmp(dis->dtype[i], "ZPX") == 0) {
        /* These are always written as TPD. */
        dotpd = DIS_DOTPD;
        strcpy(tpdsrc, dis->dtype[i]);

        if (strcmp(dis->dtype[i], "DSS") == 0) {
          strcpy(tpdsrc, wcs->wcsname);
        } else {
          strcat(tpdsrc, " \"projection\"");
d667 1
a667 1
      if (dosip) {
d670 1
a670 1
      } else if (dotpv) {
d1030 3
a1032 2
  /* Write distortion function parameters. */
  if (dosip) {
d1146 1
d1155 1
a1155 1
      if (dotpv) {
d1193 2
a1194 1
      } else if (strcmp(dis->dtype[j], "TPD") == 0 || dotpd ||
d1201 1
a1201 8
        if (strcmp(dis->dtype[j], "TPD") == 0) {
          /* Pure TPD. */
          dotpd = 1;
        } else if (strncmp(dis->dtype[j], "Polynomial", 10) == 0) {
          /* Polynomial distortion.  Write it as TPD by request? */
          dotpd = (dis->iparm[i][0] & DIS_DOTPD);
          strcpy(tpdsrc, "Polynomial distortion");
        }
d1308 3
a1310 4
          /* Template Polynomial Distortion (TPD).  As it may have been */
          /* translated from SIP, TPV, DSS, TNX, ZPX, or perhaps        */
          /* Polynomial, the dpkey records may not relate to TPD.       */
          /* Output is therefore handled via dparm.                     */
a1497 2
  }

a1498 11
  /* Add identification. */
  wcshdo_util(relax, "", "", 0, 0x0, 0, 0, 0, alt, 0, 0,
    keyvalue, comment, nkeyrec, header, &status);

  if (dotpd == DIS_DOTPD) {
    /* TPD by translation. */
    sprintf(comment, "Translated from %s to TPD by WCSLIB %s", tpdsrc,
      wcslib_version(0x0));
  } else {
    sprintf(comment, "WCS header keyrecords produced by WCSLIB %s",
      wcslib_version(0x0));
a1499 3

  wcshdo_util(relax, "COMMENT", "", 0, 0x0, 0, 0, 0, alt, 0, 0,
    keyvalue, comment, nkeyrec, header, &status);
@


5.7.1.4
log
@Further development in wcshdo() for handling distortion functions,
particularly DPja.DOCORR and the TPD auxiliary coefficients.
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 5.7.1.3 2015/07/05 08:19:49 mcalabre Exp mcalabre $
a66 1
/* Internal helper functions, not for general use. */
a484 7
#define I_DTYPE   0	/* Distortion type code.                            */
#define I_NIPARM  1	/* Full (allocated) length of iparm[].              */
#define I_NDPARM  2	/* No. of parameters in dparm[], excl. work space.  */
#define I_DOCORR  3	/* True if distortion func computes a correction.   */
#define I_TPDNCO  4	/* No. of TPD coefficients.                         */
#define I_TPDAUX  5	/* True if auxiliary variables are used.            */
#define I_TPDRAD  6	/* True if the radial variable is used.             */
d493 1
a493 2
  const char axid[] = "xyxuvu", *cp;
  const int  nTPD[] = {1, 4, 7, 12, 17, 24, 31, 40, 49, 60};
d495 1
a495 1
  char alt, comment[72], ctemp[32], *ctypei, format[8], keyvalue[72],
d498 3
a500 3
  int  *axmap, bintab, col0, *colax, colnum, degree, direct, doaux, dosip,
       dotpd, dotpv, i, idis, idp, *iparm, j, jhat, k, m, naxis, ncoeff, Nhat,
       p, pixlist, precision, primage, q, status = 0;
d606 1
a606 1
        dotpd = (dis->iparm[i][I_DTYPE] & DIS_DOTPD);
d651 1
a651 1
        dotpd = (dis->iparm[i][I_DTYPE] & DIS_DOTPD);
d680 4
a683 2
      } else if (strcmp(dis->dtype[i], "DSS") == 0) {
        /* Always written as TPD. */
a686 5
      } else if (strncmp(dis->dtype[i], "WAT", 3) == 0) {
        /* Always written as TPD. */
        dotpd = DIS_DOTPD;
        strcpy(tpdsrc, dis->dtype[i]+4);

d1081 2
a1082 2
      cp = strchr(keyp->field, '.') + 1;
      if (strncmp(cp, "SIP.", 4) != 0) continue;
d1104 1
a1104 1
      ncoeff = dis->iparm[j][I_TPDNCO];
d1120 5
a1124 5
        cp = strchr(keyp->field, '.') + 1;
        if (strncmp(cp, "SIP.FWD.", 8) != 0) continue;
        cp += 8;
        strcpy(keyword+2, cp);
        sscanf(cp, "%d_%d", &p, &q);
d1153 1
a1153 1
      ncoeff = dis->iparm[j][I_NDPARM] - dis->iparm[j][I_TPDNCO];
d1169 5
a1173 5
        cp = strchr(keyp->field, '.') + 1;
        if (strncmp(cp, "SIP.REV.", 8) != 0) continue;
        cp += 8;
        strcpy(keyword+3, cp);
        sscanf(cp, "%d_%d", &p, &q);
a1192 3
      iparm = dis->iparm[j];
      dparm = dis->dparm[j];

d1200 1
a1200 1
        wcshdo_format('E', iparm[I_NDPARM], dparm, format);
d1214 3
a1216 3
          cp = strchr(keyp->field, '.') + 1;
          if (strncmp(cp, "TPV.", 4) != 0) continue;
          strcpy(kp, cp+4);
d1219 1
a1219 1
          sscanf(cp+4, "%d", &m);
d1244 1
a1244 1
          dotpd = (iparm[I_DTYPE] & DIS_DOTPD);
a1265 1
          doaux  = iparm[I_TPDAUX];
d1315 5
a1319 5
            /* axid is "xyxuvu". */
            cp = axid; 
            if (!direct) cp++;
            if (doaux) cp += 3;
            sprintf(comment+strlen(comment), " (= %c)", cp[jhat]);
a1351 7
        /* Does the distortion function compute a correction? */
        if (iparm[I_DOCORR]) {
          wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
            "'DOCORR: 1'", "Distortion function computes a correction",
            nkeyrec, header, &status);
        }

a1356 29
          wcshdo_format('E', iparm[I_NDPARM], dparm, format);

          /* TPD.AUX.jhat.COEFF.m */
          if (doaux) {
            for (idp = 0; idp < 6; idp++) {
              if (dparm[idp] == 0.0) {
                strcpy(ctemp, "                 0.0");
              } else if (dparm[idp] == 1.0) {
                strcpy(ctemp, "                 1.0");
              } else {
                wcsutil_double2str(ctemp, format, dparm[idp]);
              }

              if (idp < 3) {
                sprintf(keyvalue, "'TPD.AUX.1.COEFF.%d: %s'", idp%3, ctemp);
                sprintf(comment, "TPD: x = c0 + c1*u + c2*v");
              } else {
                sprintf(keyvalue, "'TPD.AUX.2.COEFF.%d: %s'", idp%3, ctemp);
                sprintf(comment, "TPD: y = d0 + d1*u + d2*v");
              }

              wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
                keyvalue, comment, nkeyrec, header, &status);

            }

            dparm += 6;
          }

d1358 4
a1361 1
          for (idp = 0; idp < iparm[I_TPDNCO]; idp++) {
a1368 1

d1396 1
a1396 1
          for (idp = iparm[I_TPDNCO]; idp < iparm[I_NDPARM]; idp++) {
d1400 1
a1400 1
            m = idp - iparm[I_TPDNCO];
d1418 2
a1419 2
            cp = strchr(keyp->field, '.') + 1;
            if (strncmp(cp, "NAUX", 4) != 0) continue;
d1421 1
a1421 1
            sprintf(keyvalue, "'%s: %d'", cp, wcsutil_dpkey_int(keyp));
d1432 2
a1433 2
              cp = strchr(keyp->field, '.') + 1;
              if (strncmp(cp, "AUX.", 4) != 0) continue;
d1435 2
a1436 2
              sscanf(cp+4, "%d", &m);
              sprintf(keyvalue, "'%s:", cp);
d1438 1
a1438 1
              cp = strchr(cp+4, '.') + 1;
d1450 2
a1451 2
              sscanf(cp+6, "%d", &p);
              if (strncmp(cp, "POWER.", 4) == 0) {
d1477 2
a1478 2
            cp = strchr(keyp->field, '.') + 1;
            if (strncmp(cp, "NTERMS", 6) != 0) continue;
d1480 1
a1480 1
            sprintf(keyvalue, "'%s: %d'", cp, wcsutil_dpkey_int(keyp));
d1492 2
a1493 2
            cp = strchr(keyp->field, '.') + 1;
            if (strncmp(cp, "TERM.", 5) != 0) continue;
d1495 2
a1496 2
            sscanf(cp+5, "%d", &m);
            sprintf(keyvalue, "'%s:%s ", cp, (m<10)?" ":"");
d1498 1
a1498 1
            cp = strchr(cp+5, '.') + 1;
d1500 1
a1500 1
            if (strncmp(cp, "VAR.", 4) == 0) {
d1507 1
a1507 1
              sscanf(cp+4, "%d", &p);
@


5.7.1.5
log
@Fix for TPD auxiliary coefficients.
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 5.7.1.4 2015/07/08 07:19:57 mcalabre Exp mcalabre $
d1332 1
a1332 1
            cp = axid;
d1382 1
a1382 1
          /* AUX.jhat.COEFF.m */
d1394 1
a1394 1
                sprintf(keyvalue, "'AUX.1.COEFF.%d: %s'", idp%3, ctemp);
d1397 1
a1397 1
                sprintf(keyvalue, "'AUX.2.COEFF.%d: %s'", idp%3, ctemp);
@


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: wcshdr.c,v 5.5.1.1 2015/05/05 13:21:00 mcalabre Exp mcalabre $
d38 1
d65 2
d491 11
a501 4
  char alt, comment[72], keyvalue[72], keyword[16], obsg[8] = "OBSG?",
       obsgeo[8] = "OBSGEO-?", ptype, xtype, xyz[] = "XYZ";
  int  bintab, col0, *colax, colnum, i, j, k, naxis, pixlist, primage,
       status = 0;
d592 65
d663 2
d666 40
a705 20
      if (strncmp(wcs->ctype[i], "RA--", 4) == 0) {
        strcpy(comment, "Right ascension, ");
      } else if (strncmp(wcs->ctype[i], "DEC-", 4) == 0) {
        strcpy(comment, "Declination, ");
      } else if (strncmp(wcs->ctype[i]+1, "LON", 3) == 0 ||
                 strncmp(wcs->ctype[i]+1, "LAT", 3) == 0) {
        switch (wcs->ctype[i][0]) {
        case 'G':
          strcpy(comment, "galactic ");
          break;
        case 'E':
          strcpy(comment, "ecliptic ");
          break;
        case 'H':
          strcpy(comment, "helioecliptic ");
          break;
        case 'S':
          strcpy(comment, "supergalactic ");
          break;
        }
d707 5
a711 4
        if (i == wcs->lng) {
          strcat(comment, "longitude, ");
        } else {
          strcat(comment, "latitude, ");
d714 2
a715 1
        wcs->ctype[i][0] = toupper(wcs->ctype[i][0]);
a717 3
      strcat(comment, wcs->cel.prj.name);
      strcat(comment, " projection");

d1029 473
d1509 85
d1755 8
a1762 2
  sprintf(hptr, "%-8.8s= %-20s / %-*.*s", keyword, keyvalue, nc, nc,
    keycomment);
@


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


5.6.1.2
log
@Augmented wcshdo() to write SIP and TPV distortions.
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 5.6.1.1 2015/06/14 07:14:44 mcalabre Exp mcalabre $
a37 1
#include "dis.h"
d488 4
a491 9
  const int nTPD[] = {1, 4, 7, 12, 17, 24, 31, 40, 49, 60};

  char alt, comment[72], *ctypei, format[8], *fp, keyvalue[72], keyword[16],
       *kp, obsg[8] = "OBSG?", obsgeo[8] = "OBSGEO-?", ptype, xtype,
       tpdterm[16], xyz[] = "XYZ";
  int  bintab, col0, *colax, colnum, degree, i, idis, idp, j, k, m, naxis,
       ncoeff, pixlist, precision, primage, sip2tpd, status = 0;
  struct disprm *dis;
  struct dpkey  *keyp;
a587 2

    ctypei = keyvalue + 1;
d589 19
a607 7
      /* May need to alter ctype for particular distortions. */
      if ((dis = wcs->lin.dispre) && strcmp(dis->dtype[i], "SIP") == 0) {
        /* Simple Imaging Polynomial (SIP); was it permuted by wcssub()? */
        if (strcmp(wcs->ctype[0], "RA---TAN-SIP") ||
            strcmp(wcs->ctype[1], "DEC--TAN-SIP")) {
          /* Yes.  Native SIP doesn't have axis mapping so use TPD. */
          ctypei[8] = '\0';
d610 4
a613 43
      } else if ((dis = wcs->lin.disseq) &&
                  strcmp(dis->dtype[i], "TPV") == 0) {
        /* TPV "projection"; reinstate projection code edited by wcsset(). */
        strncpy(ctypei+5, "TPV", 3);
      }

      if (strncmp(ctypei+4, "-TPV", 4) == 0) {
        strcpy(comment, "TAN (gnomonic) projection + distortions");

      } else if (strncmp(ctypei+8, "-SIP", 4) == 0) {
        strcpy(comment, "TAN (gnomonic) projection + SIP distortions");

      } else {
        if (strncmp(ctypei, "RA--", 4) == 0) {
          strcpy(comment, "Right ascension, ");

        } else if (strncmp(ctypei, "DEC-", 4) == 0) {
          strcpy(comment, "Declination, ");

        } else if (strncmp(ctypei+1, "LON", 3) == 0 ||
                   strncmp(ctypei+1, "LAT", 3) == 0) {
          ctypei[0] = toupper(ctypei[0]);

          switch (ctypei[0]) {
          case 'G':
            strcpy(comment, "galactic ");
            break;
          case 'E':
            strcpy(comment, "ecliptic ");
            break;
          case 'H':
            strcpy(comment, "helioecliptic ");
            break;
          case 'S':
            strcpy(comment, "supergalactic ");
            break;
          }

          if (i == wcs->lng) {
            strcat(comment, "longitude, ");
          } else {
            strcat(comment, "latitude, ");
          }
d616 1
a616 2
        strcat(comment, wcs->cel.prj.name);
        strcat(comment, " projection");
d619 3
a931 204


  /* As far as possible, write distortion functions in the form of the */
  /* convention recorded in disprm::dtype.                             */
  sip2tpd = 0;
  if ((dis = wcs->lin.dispre) && strcmp(dis->dtype[0], "SIP") == 0) {
    /* Simple Imaging Polynomial (SIP); was it permuted by wcssub()? */
    if (strcmp(wcs->ctype[0], "RA---TAN-SIP") ||
        strcmp(wcs->ctype[1], "DEC--TAN-SIP")) {
      /* Yes.  Native SIP doesn't have axis mapping so use TPD. */
      sip2tpd = 1;

    } else {
      /* SIP is handled by translating its dpkey records.             */
      /* Determine a suitable numerical precision for the polynomial  */
      /* coefficients to avoid trailing zeroes common to all of them. */
      keyp = dis->dp;
      kp = keyvalue + 3;
      for (idp = 0; idp < dis->ndp; idp++, keyp++) {
        fp = strpbrk(keyp->field, ".") + 1;
        if (strncmp(fp, "SIP.", 4) != 0) continue;
        wcsutil_double2str(keyvalue, "%20.13E", keyp->value.f);
        while (*kp != '0' && *kp != 'E') kp++;
      }

      precision = kp - keyvalue - 3;
      if (precision < 1)  precision = 1;
      if (13 < precision) precision = 13;
      sprintf(format, "%%20.%dE", precision);

      /* Ensure the coefficients are written in a human-readable sequence. */
      for (j = 1; j <= 2; j++) {
        /* Distortion function polynomial coefficients. */
        wcshdo_util(relax, "", "", 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
          nkeyrec, header, &status);

        if (j == 1) {
          strcpy(keyword, "A_");
        } else {
          strcpy(keyword, "B_");
        }

        ncoeff = dis->iparm[j-1][3];
        for (degree = 0; degree <= 9; degree++) {
          if (ncoeff <= nTPD[degree]) break;
        }

        strcpy(keyword+2, "ORDER");
        sprintf(keyvalue, "%20d", degree);
        sprintf(comment, "SIP polynomial degree, axis %d, pixel-to-sky", j);
        wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
          keyvalue, comment, nkeyrec, header, &status);

        keyp = dis->dp;
        for (idp = 0; idp < dis->ndp; idp++, keyp++) {
          if (keyp->j != j) continue;
          fp = strpbrk(keyp->field, ".") + 1;

          if (strncmp(fp, "SIP.FWD.", 8) != 0) continue;
          strcpy(keyword+2, fp+8);

          wcsutil_double2str(keyvalue, format, keyp->value.f);
          wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
            keyvalue, "SIP distortion polynomial coefficient", nkeyrec,
            header, &status);
        }

        strcpy(keyword+2, "MAX");
        wcsutil_double2str(keyvalue, "%20.3f", dis->maxdis[j-1]);
        wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
          keyvalue, "Maximum value of distortion function", nkeyrec,
          header, &status);
      }

      for (j = 1; j <= 2; j++) {
        /* Inverse distortion function polynomial coefficients. */
        wcshdo_util(relax, "", "", 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
          nkeyrec, header, &status);

        if (j == 1) {
          strcpy(keyword, "AP_");
        } else {
          strcpy(keyword, "BP_");
        }

        ncoeff = dis->iparm[j-1][2] - dis->iparm[j-1][3];
        for (degree = 0; degree <= 9; degree++) {
          if (ncoeff <= nTPD[degree]) break;
        }

        strcpy(keyword+3, "ORDER");
        sprintf(keyvalue, "%20d", degree);
        sprintf(comment, "SIP polynomial degree, axis %d, sky-to-pixel", j);
        wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
          keyvalue, comment, nkeyrec, header, &status);

        keyp = dis->dp;
        for (idp = 0; idp < dis->ndp; idp++, keyp++) {
          if (keyp->j != j) continue;
          fp = strpbrk(keyp->field, ".") + 1;

          if (strncmp(fp, "SIP.REV.", 8) != 0) continue;
          strcpy(keyword+3, fp+8);

          wcsutil_double2str(keyvalue, format, keyp->value.f);
          wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
            keyvalue, "SIP inverse polynomial coefficient",
            nkeyrec, header, &status);
        }
      }
    }
  }


  for (idis = 0; idis < 2; idis++) {
    if (idis == 0 && (dis = wcs->lin.dispre) == 0x0) continue;
    if (idis == 1 && (dis = wcs->lin.disseq) == 0x0) continue;

    for (j = 0; j < naxis; j++) {
      if (dis->disp2x[j] == 0x0) continue;

      /* Identify the distortion type. */
      if (strcmp(dis->dtype[j], "TPV") == 0) {
        /* TPV "projection" is handled by translating its dpkey records, */
        /* which were originally translated from PVi_ma by wcsset().     */
        /* Determine a suitable numerical precision for the polynomial   */
        /* coefficients to avoid trailing zeroes common to all of them.  */
        keyp = dis->dp;
        kp = keyvalue + 3;
        for (idp = 0; idp < dis->ndp; idp++, keyp++) {
          fp = strpbrk(keyp->field, ".") + 1;
          if (strncmp(fp, "TPV.", 4) != 0) continue;
          wcsutil_double2str(keyvalue, "%20.13E", keyp->value.f);
          while (*kp != '0' && *kp != 'E') kp++;
        }

        precision = kp - keyvalue - 3;
        if (precision < 1)  precision = 1;
        if (13 < precision) precision = 13;
        sprintf(format, "%%20.%dE", precision);

        wcshdo_util(relax, "", "", 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
          nkeyrec, header, &status);

        /* Distortion function polynomial coefficients. */
        sprintf(keyword, "PV%d_", j+1);
        kp = keyword + strlen(keyword);

        keyp = dis->dp;
        for (idp = 0; idp < dis->ndp; idp++, keyp++) {
          if (keyp->j != j+1) continue;
          fp = strpbrk(keyp->field, ".") + 1;

          if (strncmp(fp, "TPV.", 4) != 0) continue;
          strcpy(kp, fp+4);

          /* Identify the term of the TPV polynomial for human readers. */
          sscanf(fp+4, "%d", &m);
          for (degree = 0; degree <= 9; degree++) {
            if (m < nTPD[degree]) break;
          }

          if (degree == 0) {
            strcpy(tpdterm, "1");

          } else {
            k = degree - (m - nTPD[degree-1]);

            if (k < 0) {
              strncpy(tpdterm, "rrrrrrrrr", degree);
            } else if (j == wcs->lng) {
              strncpy(tpdterm, "xxxxxxxxx", k);
              strncpy(tpdterm+k, "yyyyyyyyy", degree-k);
            } else {
              strncpy(tpdterm, "yyyyyyyyy", k);
              strncpy(tpdterm+k, "xxxxxxxxx", degree-k);
            }

            tpdterm[degree] = '\0';
          }

          sprintf(comment, "TPV distortion coefficient: %s", tpdterm);

          wcsutil_double2str(keyvalue, format, keyp->value.f);
          wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
            keyvalue, comment, nkeyrec, header, &status);
        }

      } else if (sip2tpd || strcmp(dis->dtype[j], "TPD") == 0) {
        /* Template Polynomial Distortion. */
        /* >>> TBD <<< */

      } else if (strcmp(dis->dtype[j], "Polynomial")  == 0 ||
                 strcmp(dis->dtype[j], "Polynomial*") == 0) {
        /* General polynomial distortion. */
        /* >>> TBD <<< */
      }

      if (dis->disx2p[j] == 0x0) continue;
      /* >>> TBD <<< */

    }
  }

@


5.6.1.3
log
@Checkpoint further development of wcshdo(), now with the added capability
of writing TPD distortions.
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 5.6.1.2 2015/06/19 09:25:58 mcalabre Exp mcalabre $
a64 2
static void wcshdo_format(int, int, const double [], char *);
static void wcshdo_tpdterm(int, int, char *);
d491 5
a495 7
  char alt, comment[72], ctemp[32], *ctypei, format[8], *fp, keyvalue[72],
       keyword[16], *kp, obsg[8] = "OBSG?", obsgeo[8] = "OBSGEO-?", pq, ptype,
       xtype, term[16], xyz[] = "XYZ";
  int  bintab, col0, *colax, colnum, degree, dosip, dotpv, i, idis, idp,
       *iparm, j, jhat, k, m, naxis, ncoeff, p, pixlist, precision, primage,
       q, status = 0;
  double *dparm;
a587 65
  /* May need to alter ctype for particular distortions so do basic checks. */
  dosip = 0;
  dotpv = 0;
  if ((dis = wcs->lin.dispre)) {
    for (i = 0; i < naxis; i++) {
      if (strcmp(dis->dtype[i], "SIP") == 0) {
        /* Simple Imaging Polynomial (SIP). */
        dosip = 1;

        if (alt ||
            dis->axmap[0][0]  != 0 ||
            dis->axmap[0][1]  != 1 ||
            dis->axmap[1][0]  != 0 ||
            dis->axmap[1][1]  != 1 ||
            dis->offset[0][0] != wcs->crpix[0] ||
            dis->offset[0][1] != wcs->crpix[1] ||
            dis->offset[1][0] != wcs->crpix[0] ||
            dis->offset[1][1] != wcs->crpix[1] ||
            dis->scale[0][0]  != 1.0 ||
            dis->scale[0][1]  != 1.0 ||
            dis->scale[1][0]  != 1.0 ||
            dis->scale[1][1]  != 1.0) {
          /* Must have been read as a 'SIP' distortion, CPDISja = 'SIP'. */
          /* Can't be written as native SIP so write it as TPD.          */
          dosip = 2;
        } else if (strncmp(wcs->ctype[0], "RA---TAN", 8) ||
                   strncmp(wcs->ctype[1], "DEC--TAN", 8)) {
          /* Must have been permuted by wcssub(). */
          /* Native SIP doesn't have axis mapping so write it as TPD. */
          dosip = 2;
        }

        break;
      }
    }
  }

  if ((dis = wcs->lin.disseq)) {
    for (i = 0; i < naxis; i++) {
      if (strcmp(dis->dtype[i], "TPV") == 0) {
        /* TPV "projection". */
        dotpv = 1;

        if (dis->axmap[wcs->lng][0] != wcs->lng ||
            dis->axmap[wcs->lng][1] != wcs->lat ||
            dis->axmap[wcs->lat][0] != wcs->lat ||
            dis->axmap[wcs->lat][1] != wcs->lng ||
            dis->offset[wcs->lng][wcs->lng] != 0.0 ||
            dis->offset[wcs->lng][wcs->lat] != 0.0 ||
            dis->offset[wcs->lat][wcs->lng] != 0.0 ||
            dis->offset[wcs->lat][wcs->lat] != 0.0 ||
            dis->scale[wcs->lng][wcs->lng]  != 1.0 ||
            dis->scale[wcs->lng][wcs->lat]  != 1.0 ||
            dis->scale[wcs->lat][wcs->lng]  != 1.0 ||
            dis->scale[wcs->lat][wcs->lat]  != 1.0) {
          /* Must have been read as a 'TPV' distortion, CPDISja = 'TPV'. */
          /* Can't be written as native TPV so write it as TPD.          */
          dotpv = 2;
        }

        break;
      }
    }
  }

d597 13
a609 7
      /* Alter ctype for particular distortions. */
      if (dosip == 1) {
        /* It could have come in as CPDISja = 'SIP'. */
        strcpy(ctypei+8, "-SIP'");
      } else if (dotpv == 1) {
        /* Reinstate projection code edited by wcsset(). */
        strcpy(ctypei+4, "-TPV");
d612 4
a615 1
      if (strncmp(ctypei+8, "-SIP", 4) == 0) {
a617 3
      } else if (strncmp(ctypei+4, "-TPV", 4) == 0) {
        strcpy(comment, "TAN (gnomonic) projection + distortions");

d969 7
a975 25
  if (dosip == 1) {
    /* Simple Imaging Polynomial (SIP) is handled by translating its dpkey */
    /* records.  Determine a suitable numerical precision for the          */
    /* polynomial coefficients to avoid trailing zeroes common to all of   */
    /* them.                                                               */
    dis = wcs->lin.dispre;
    keyp = dis->dp;
    kp = keyvalue + 3;
    for (idp = 0; idp < dis->ndp; idp++, keyp++) {
      fp = strpbrk(keyp->field, ".") + 1;
      if (strncmp(fp, "SIP.", 4) != 0) continue;
      wcsutil_double2str(keyvalue, "%20.13E", keyp->value.f);
      while (*kp != '0' && *kp != 'E') kp++;
    }

    precision = kp - keyvalue - 3;
    if (precision < 1)  precision = 1;
    if (13 < precision) precision = 13;
    sprintf(format, "%%20.%dE", precision);

    /* Ensure the coefficients are written in a human-readable sequence. */
    for (j = 1; j <= 2; j++) {
      /* Distortion function polynomial coefficients. */
      wcshdo_util(relax, "", "", 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
        nkeyrec, header, &status);
d977 11
a987 4
      if (j == 1) {
        strcpy(keyword, "A_");
      } else {
        strcpy(keyword, "B_");
d990 10
a999 4
      ncoeff = dis->iparm[j-1][3];
      for (degree = 0; degree <= 9; degree++) {
        if (ncoeff <= nTPD[degree]) break;
      }
d1001 5
a1005 5
      strcpy(keyword+2, "ORDER");
      sprintf(keyvalue, "%20d", degree);
      sprintf(comment, "SIP polynomial degree, axis %d, pixel-to-sky", j);
      wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, ' ', 0, 0,
        keyvalue, comment, nkeyrec, header, &status);
d1007 4
a1010 4
      keyp = dis->dp;
      for (idp = 0; idp < dis->ndp; idp++, keyp++) {
        if (keyp->j != j) continue;
        fp = strpbrk(keyp->field, ".") + 1;
d1012 4
a1015 11
        if (strncmp(fp, "SIP.FWD.", 8) != 0) continue;
        fp += 8;
        strcpy(keyword+2, fp);
        sscanf(fp, "%d_%d", &p, &q);
        strncpy(term, "xxxxxxxxx", p);
        strncpy(term+p, "yyyyyyyyy", q);
        term[p+q] = '\0';

        wcsutil_double2str(keyvalue, format, keyp->value.f);
        sprintf(comment, "SIP distortion coefficient: %s", term);
        wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, ' ', 0, 0,
a1016 1
      }
d1018 4
a1021 5
      strcpy(keyword+2, "MAX");
      wcsutil_double2str(keyvalue, "%20.3f", dis->maxdis[j-1]);
      wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, ' ', 0, 0,
        keyvalue, "Maximum value of distortion function", nkeyrec,
        header, &status);
d1023 2
a1024 2
      /* Inverse distortion function polynomial coefficients. */
      if (dis->disx2p == 0x0) continue;
d1026 5
a1030 2
      wcshdo_util(relax, "", "", 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
        nkeyrec, header, &status);
d1032 5
a1036 4
      if (j == 1) {
        strcpy(keyword, "AP_");
      } else {
        strcpy(keyword, "BP_");
d1039 4
a1042 4
      ncoeff = dis->iparm[j-1][2] - dis->iparm[j-1][3];
      for (degree = 0; degree <= 9; degree++) {
        if (ncoeff <= nTPD[degree]) break;
      }
d1044 5
a1048 5
      strcpy(keyword+3, "ORDER");
      sprintf(keyvalue, "%20d", degree);
      sprintf(comment, "SIP polynomial degree, axis %d, sky-to-pixel", j);
      wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, ' ', 0, 0,
        keyvalue, comment, nkeyrec, header, &status);
d1050 4
a1053 4
      keyp = dis->dp;
      for (idp = 0; idp < dis->ndp; idp++, keyp++) {
        if (keyp->j != j) continue;
        fp = strpbrk(keyp->field, ".") + 1;
d1055 4
a1058 11
        if (strncmp(fp, "SIP.REV.", 8) != 0) continue;
        fp += 8;
        strcpy(keyword+3, fp);
        sscanf(fp, "%d_%d", &p, &q);
        strncpy(term, "xxxxxxxxx", p);
        strncpy(term+p, "yyyyyyyyy", q);
        term[p+q] = '\0';

        wcsutil_double2str(keyvalue, format, keyp->value.f);
        sprintf(comment, "SIP inverse coefficient: %s", term);
        wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, ' ', 0, 0,
d1060 14
d1087 1
a1087 1
      if (strcmp(dis->dtype[j], "TPV") == 0 && dotpv == 1) {
d1089 1
a1089 2
        /* which were originally translated from PVi_ma by wcsset(), or  */
        /* possibly input directly as a CQDISia = 'TPV' distortion type. */
d1123 3
a1125 2
          wcshdo_tpdterm(m, j == wcs->lng, term);
          sprintf(comment, "TPV coefficient: %s", term);
d1127 2
a1128 4
          wcsutil_double2str(keyvalue, format, keyp->value.f);
          wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
            keyvalue, comment, nkeyrec, header, &status);
        }
d1130 2
a1131 7
      } else if (strcmp(dis->dtype[j], "TPD") == 0 ||
                 dosip == 2 || dotpv == 2) {
        /* Template Polynomial Distortion.  As it may have been translated */
        /* from SIP, TPV, or perhaps Polynomial, the dpkey records may not */
        /* relate to TPD.  Output is therefore handled via dparm.          */
        wcshdo_util(relax, "", "", 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
          nkeyrec, header, &status);
d1133 9
a1141 1
        pq = idis ? 'Q' : 'P';
d1143 1
a1143 29
        /* CPDISja/CQDISia */
        sprintf(keyword, "C%cDIS%d", pq, j+1);
        strcpy(keyvalue, "'TPD'");
        if (idis == 0) {
          strcpy(comment, "P = prior, Template Polynomial Distortion");
        } else {
          strcpy(comment, "Q = sequent, Template Polynomial Distortion");
        }
        wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
          keyvalue, comment, nkeyrec, header, &status);

        /* NAXES.  Usually 2, but it's possible to have only 1. */
        sprintf(keyword,  "D%c%d", pq, j+1);
        sprintf(keyvalue, "'NAXES:  %d'", dis->Nhat[j]);
        if (dis->Nhat[j] == 1) {
          strcpy(comment,  "One independent variable");
        } else if (dis->Nhat[j] == 2) {
          strcpy(comment,  "Two independent variables");
        }
        wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
          keyvalue, comment, nkeyrec, header, &status);

        /* AXIS.jhat */
        for (jhat = 0; jhat < dis->Nhat[j]; jhat++) {
          sprintf(keyvalue, "'AXIS.%d: %d'", jhat+1, dis->axmap[j][jhat]+1);
          if (jhat == 0) {
            strcpy(comment, "1st");
          } else if (jhat == 1) {
            strcpy(comment, "2nd");
d1146 1
a1146 5
          if (dis->axmap[j][jhat] == 0) {
            strcat(comment, " independent variable: axis 1 (= x)");
          } else {
            strcat(comment, " independent variable: axis 2 (= y)");
          }
d1148 1
d1153 3
a1155 75
        /* OFFSET.jhat */
        wcshdo_format('f', dis->Nhat[j], dis->offset[j], format);
        for (jhat = 0; jhat < dis->Nhat[j]; jhat++) {
          if (dis->offset[j][jhat] == 0.0) continue;

          wcsutil_double2str(ctemp, format, dis->offset[j][jhat]);
          sprintf(keyvalue, "'OFFSET.%d: %s'", jhat+1, ctemp);
          sprintf(comment, "Variable %d renormalization offset", jhat+1);

          wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
            keyvalue, comment, nkeyrec, header, &status);
        }

        /* SCALE.jhat */
        wcshdo_format('f', dis->Nhat[j], dis->scale[j], format);
        for (jhat = 0; jhat < dis->Nhat[j]; jhat++) {
          if (dis->scale[j][jhat] == 1.0) continue;

          wcsutil_double2str(ctemp, format, dis->scale[j][jhat]);
          sprintf(keyvalue, "'SCALE.%d: %s'", jhat+1, ctemp);
          sprintf(comment, "Variable %d renormalization scale", jhat+1);

          wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
            keyvalue, comment, nkeyrec, header, &status);
        }

        /* TPD.FWD.m */
        iparm = dis->iparm[j];
        dparm = dis->dparm[j];
        wcshdo_format('E', iparm[2], dparm, format);
        for (idp = 0; idp < iparm[3]; idp++) {
          if (dparm[idp] == 0.0) continue;

          wcsutil_double2str(ctemp, format, dparm[idp]);
          m = idp;
          sprintf(keyvalue, "'TPD.FWD.%d:%s %s'", m, (m<10)?" ":"", ctemp);
/* >>> This may not be valid in all cases. <<< */
          wcshdo_tpdterm(m, dis->axmap[j][0] == 0, term);
          sprintf(comment, "TPD coefficient: %s", term);

          wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
            keyvalue, comment, nkeyrec, header, &status);
        }

        /* CPERRja/CQERRia */
        if (dis->maxdis[j] != 0.0) {
          sprintf(keyword,  "C%cERR%d", pq, j+1);
          sprintf(keyvalue, "%20.2f", dis->maxdis[j]);
          sprintf(comment, "%sMaximum absolute value of distortion",
            idis?"":"[pix] ");
          wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
            keyvalue, comment, nkeyrec, header, &status);
        }

        /* Inverse distortion function polynomial coefficients. */
        if (dis->disx2p[j] == 0x0) continue;

        wcshdo_util(relax, "", "", 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
          nkeyrec, header, &status);

        /* TPD.REV.m */
        sprintf(keyword,  "D%c%d", pq, j+1);
        for (idp = iparm[3]; idp < iparm[2]; idp++) {
          if (dparm[idp] == 0.0) continue;

          wcsutil_double2str(ctemp, format, dparm[idp]);
          m = idp - iparm[3];
          sprintf(keyvalue, "'TPD.REV.%d:%s %s'", m, (m<10)?" ":"", ctemp);
/* >>> This may not be valid in all cases. <<< */
          wcshdo_tpdterm(m, dis->axmap[j][0] == 0, term);
          sprintf(comment, "TPD coefficient: %s", term);

          wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
            keyvalue, comment, nkeyrec, header, &status);
        }
a1161 1
    }
d1163 3
a1165 6
    /* DVERRa */
    if (dis->totdis != 0.0) {
      sprintf(keyvalue, "%20.2f", dis->totdis);
      sprintf(comment, "Maximum combined distortion");
      wcshdo_util(relax, "DVERR", "", 0, 0x0, 0, 0, 0, alt, 0, 0,
        keyvalue, comment, nkeyrec, header, &status);
a1166 1

a1176 85
/* Determine a suitable floating point format for a set of parameters.      */

void wcshdo_format(
  int fmt,
  int nval,
  const double value[],
  char *format)

{
  char *cp, cvalue[24];
  int  i, j, nblank, precision;

  if (fmt == 'f') {
    nblank = 8;
    cp = cvalue + 10;
    for (i = 0; i < nval; i++) {
      wcsutil_double2str(cvalue, "%20.10f", value[i]);

      for (j = 0; j <= nblank; j++) {
        if (cvalue[j] != ' ') {
          if (j < nblank) nblank = j;
          break;
        }
      }

      while (*cp && *cp != '0') cp++;
    }

    precision = cp - (cvalue + 10);
    if (precision < 1)  precision = 1;
    sprintf(format, "%%%d.%df", (10-nblank)+precision, precision);

  } else {
    cp = cvalue + 3;
    for (i = 0; i < nval; i++) {
      wcsutil_double2str(cvalue, "%20.13E", value[i]);
      while (*cp != '0' && *cp != 'E') cp++;
    }

    precision = cp - cvalue - 3;
    if (precision < 1)  precision = 1;
    if (13 < precision) precision = 13;
    sprintf(format, "%%20.%dE", precision);
  }
}

/*--------------------------------------------------------------------------*/
/* Construct a string that identifies the term of a TPD or TPV polynomial.  */

void wcshdo_tpdterm(
  int m,
  int direct,
  char *term)

{
  const int nTPD[] = {1, 4, 7, 12, 17, 24, 31, 40, 49, 60};

  int degree, k;

  for (degree = 0; degree <= 9; degree++) {
    if (m < nTPD[degree]) break;
  }

  if (degree == 0) {
    strcpy(term, "1");

  } else {
    k = degree - (m - nTPD[degree-1]);

    if (k < 0) {
      strncpy(term, "rrrrrrrrr", degree);
    } else if (direct) {
      strncpy(term, "xxxxxxxxx", k);
      strncpy(term+k, "yyyyyyyyy", degree-k);
    } else {
      strncpy(term, "yyyyyyyyy", k);
      strncpy(term+k, "xxxxxxxxx", degree-k);
    }

    term[degree] = '\0';
  }
}

/*--------------------------------------------------------------------------*/
/* Construct a keyrecord from the components given.                         */
d1338 2
a1339 8
  if (*keyword == '\0') {
    sprintf(hptr, "%80.80s", " ");
  } else if (strcmp(keyword, "COMMENT") == 0) {
    sprintf(hptr, "%-8.8s %-71.71s", keyword, keycomment);
  } else {
    sprintf(hptr, "%-8.8s= %-20s / %-*.*s", keyword, keyvalue, nc, nc,
      keycomment);
  }
@


5.6.1.4
log
@Augmented wcshdo() to write TPD and Polynomial distortions.  Minor changes
to SIP and TPV.
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 5.6.1.3 2015/06/22 12:38:39 mcalabre Exp mcalabre $
d496 4
a499 4
  int  *axmap, bintab, col0, *colax, colnum, degree, direct, dosip, dotpd,
       dotpv, i, idis, idp, *iparm, j, jhat, k, m, naxis, ncoeff, Nhat, p,
       pixlist, precision, primage, q, status = 0;
  double *dparm, keyval;
d1043 1
a1043 1
      wcsutil_double2str(keyvalue, "%20.13E", wcsutil_dpkey_double(keyp));
d1053 1
a1053 1
    for (j = 0; j <= 1; j++) {
d1058 1
a1058 1
      if (j == 0) {
d1064 1
a1064 1
      ncoeff = dis->iparm[j][3];
d1077 2
a1078 2
        if (keyp->j != j+1) continue;
        if ((keyval = wcsutil_dpkey_double(keyp)) == 0.0) continue;
a1079 1
        fp = strpbrk(keyp->field, ".") + 1;
d1088 1
a1088 1
        wcsutil_double2str(keyvalue, format, keyval);
d1095 1
a1095 1
      wcsutil_double2str(keyvalue, "%20.3f", dis->maxdis[j]);
d1106 1
a1106 1
      if (j == 0) {
d1112 1
a1112 1
      ncoeff = dis->iparm[j][2] - dis->iparm[j][3];
d1119 1
a1119 1
      sprintf(comment, "SIP polynomial degree, axis %d, sky-to-pixel", j+1);
d1125 2
a1126 2
        if (keyp->j != j+1) continue;
        if ((keyval = wcsutil_dpkey_double(keyp)) == 0.0) continue;
a1127 1
        fp = strpbrk(keyp->field, ".") + 1;
d1136 1
a1136 1
        wcsutil_double2str(keyvalue, format, keyval);
d1159 13
a1171 1
        wcshdo_format('E', dis->iparm[j][2], dis->dparm[j], format);
d1183 1
a1183 1
          if ((keyval = wcsutil_dpkey_double(keyp)) == 0.0) continue;
a1184 1
          fp = strpbrk(keyp->field, ".") + 1;
d1193 1
a1193 5
          if (keyval == 1.0) {
            strcpy(keyvalue, "                 1.0");
          } else {
            wcsutil_double2str(keyvalue, format, keyval);
          }
d1199 4
a1202 4
                 dosip == 2 || dotpv == 2 ||
                 strcmp(dis->dtype[j], "Polynomial")  == 0 ||
                 strcmp(dis->dtype[j], "Polynomial*") == 0) {
        /* One of the Paper IV type polynomial distortions. */
a1205 2
        dotpd = strncmp(dis->dtype[j], "Polynomial", 10);

a1206 1
        Nhat = dis->Nhat[j];
d1210 1
d1212 1
a1212 23
          strcpy(comment, "P = prior, ");
        } else {
          strcpy(comment, "Q = sequent, ");
        }

        if (dotpd) {
          strcpy(keyvalue, "'TPD'");
          strcat(comment, "Template Polynomial Distortion");

          /* For identifying terms of the TPD polynomial. */
          axmap  = dis->axmap[j];
          direct = 1;
          if (Nhat == 2) {
            /* Associate x with longitude, y with latitude. */
            if (axmap[0] == wcs->lng && axmap[1] == wcs->lat) {
              direct = 1;
            } else if (axmap[0] == wcs->lat && axmap[1] == wcs->lng) {
              direct = 0;
            } else {
              /* Non-celestial. */
              direct = (axmap[0] < axmap[1]);
            }
          }
d1214 1
a1214 2
          strcpy(keyvalue, "'Polynomial'");
          strcat(comment, "general Polynomial distortion");
a1215 1

d1219 1
a1219 1
        /* NAXES. */
d1221 2
a1222 2
        sprintf(keyvalue, "'NAXES:  %d'", Nhat);
        if (Nhat == 1) {
d1224 1
a1224 1
        } else if (Nhat == 2) {
a1225 2
        } else {
          strcpy(comment,  "Number of independent variables");
d1231 2
a1232 3
        for (jhat = 0; jhat < Nhat; jhat++) {
          axmap = dis->axmap[j];
          sprintf(keyvalue, "'AXIS.%d: %d'", jhat+1, axmap[jhat]+1);
a1236 4
          } else if (jhat == 2) {
            strcpy(comment, "3rd");
          } else {
            sprintf(comment, "%dth", jhat+1);
d1239 4
a1242 8
          sprintf(comment+strlen(comment), " independent variable: axis %d",
            axmap[jhat]+1);
          if (dotpd) {
            if (jhat == 0) {
              sprintf(comment+strlen(comment), " (= %c)", direct?'x':'y');
            } else {
              sprintf(comment+strlen(comment), " (= %c)", direct?'y':'x');
            }
d1250 2
a1251 2
        wcshdo_format('f', Nhat, dis->offset[j], format);
        for (jhat = 0; jhat < Nhat; jhat++) {
d1263 2
a1264 2
        wcshdo_format('f', Nhat, dis->scale[j], format);
        for (jhat = 0; jhat < Nhat; jhat++) {
d1275 13
a1287 20
        if (dotpd) {
          /* Template Polynomial Distortion.  As it may have been translated */
          /* from SIP, TPV, or perhaps Polynomial, the dpkey records may not */
          /* relate to TPD.  Output is therefore handled via dparm.          */
          /* TPD.FWD.m */
          iparm = dis->iparm[j];
          dparm = dis->dparm[j];
          wcshdo_format('E', iparm[2], dparm, format);
          for (idp = 0; idp < iparm[3]; idp++) {
            if (dparm[idp] == 0.0) continue;

            if (dparm[idp] == 1.0) {
              strcpy(ctemp, "                 1.0");
            } else {
              wcsutil_double2str(ctemp, format, dparm[idp]);
            }
            m = idp;
            sprintf(keyvalue, "'TPD.FWD.%d:%s %s'", m, (m<10)?" ":"", ctemp);
            wcshdo_tpdterm(m, direct, term);
            sprintf(comment, "TPD coefficient: %s", term);
d1289 3
a1291 3
            wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
              keyvalue, comment, nkeyrec, header, &status);
          }
d1293 9
a1301 9
          /* CPERRja/CQERRia */
          if (dis->maxdis[j] != 0.0) {
            sprintf(keyword,  "C%cERR%d", pq, j+1);
            sprintf(keyvalue, "%20.2f", dis->maxdis[j]);
            sprintf(comment, "%sMaximum absolute value of distortion",
              idis?"":"[pix] ");
            wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
              keyvalue, comment, nkeyrec, header, &status);
          }
d1303 2
a1304 2
          /* Inverse distortion function polynomial coefficients. */
          if (dis->disx2p[j] == 0x0) continue;
d1306 2
a1307 2
          wcshdo_util(relax, "", "", 0, 0x0, 0, 0, 0, ' ', 0, 0, "", "",
            nkeyrec, header, &status);
d1309 4
a1312 10
          /* TPD.REV.m */
          sprintf(keyword,  "D%c%d", pq, j+1);
          for (idp = iparm[3]; idp < iparm[2]; idp++) {
            if (dparm[idp] == 0.0) continue;

            wcsutil_double2str(ctemp, format, dparm[idp]);
            m = idp - iparm[3];
            sprintf(keyvalue, "'TPD.REV.%d:%s %s'", m, (m<10)?" ":"", ctemp);
            wcshdo_tpdterm(m, direct, term);
            sprintf(comment, "TPD coefficient: %s", term);
d1314 6
a1319 3
            wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
              keyvalue, comment, nkeyrec, header, &status);
          }
d1321 3
a1323 3
        } else {
          /* General polynomial distortion, handled via its dpkey records */
          /* since iparm and dparm may hold a translation to TPD.         */
d1325 4
a1328 121
          /* Do auxiliary variables first. */
          keyp = dis->dp;
          for (idp = 0; idp < dis->ndp; idp++, keyp++) {
            if (keyp->j != j+1) continue;

            fp = strpbrk(keyp->field, ".") + 1;
            if (strncmp(fp, "NAUX", 4) != 0) continue;

            sprintf(keyvalue, "'%s: %d'", fp, wcsutil_dpkey_int(keyp));
            wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
              keyvalue, "Number of auxiliary variables", nkeyrec, header,
              &status);

            keyp = dis->dp;
            for (idp = 0; idp < dis->ndp; idp++, keyp++) {
              if (keyp->j != j+1) continue;

              keyval = wcsutil_dpkey_double(keyp);

              fp = strpbrk(keyp->field, ".") + 1;
              if (strncmp(fp, "AUX.", 4) != 0) continue;

              sscanf(fp+4, "%d", &m);
              sprintf(keyvalue, "'%s:", fp);

              fp = strpbrk(fp+4, ".") + 1;
              kp = keyvalue + strlen(keyvalue);

              if ((double)((int)keyval) == keyval) {
                sprintf(kp, "%4d'", (int)keyval);
              } else if (keyval == 0.5) {
                strcat(kp, " 0.5'");
              } else {
                wcsutil_double2str(kp, "%21.13E", keyval);
                strcat(keyvalue, "'");
              }

              sscanf(fp+6, "%d", &p);
              if (strncmp(fp, "POWER.", 4) == 0) {
                if (p) {
                  sprintf(comment, "Aux %d: var %d power", m, p);
                } else {
                  sprintf(comment, "Aux %d: power of sum of terms", m);
                }
              } else {
                if (p) {
                  sprintf(comment, "Aux %d: var %d coefficient", m, p);
                } else {
                  sprintf(comment, "Aux %d: offset term", m);
                }
              }

              wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
                keyvalue, comment, nkeyrec, header, &status);
            }

            break;
          }

          /* Do polynomial terms. */
          keyp = dis->dp;
          for (idp = 0; idp < dis->ndp; idp++, keyp++) {
            if (keyp->j != j+1) continue;

            fp = strpbrk(keyp->field, ".") + 1;
            if (strncmp(fp, "NTERMS", 6) != 0) continue;

            sprintf(keyvalue, "'%s: %d'", fp, wcsutil_dpkey_int(keyp));
            wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
              keyvalue, "Number of terms in the polynomial", nkeyrec, header,
              &status);
          }

          keyp = dis->dp;
          for (idp = 0; idp < dis->ndp; idp++, keyp++) {
            if (keyp->j != j+1) continue;

            if ((keyval = wcsutil_dpkey_double(keyp)) == 0.0) continue;

            fp = strpbrk(keyp->field, ".") + 1;
            if (strncmp(fp, "TERM.", 5) != 0) continue;

            sscanf(fp+5, "%d", &m);
            sprintf(keyvalue, "'%s:%s ", fp, (m<10)?" ":"");

            fp = strpbrk(fp+5, ".") + 1;
            kp = keyvalue + strlen(keyvalue);
            if (strncmp(fp, "VAR.", 4) == 0) {
              if ((double)((int)keyval) == keyval) {
                sprintf(kp, "%20d", (int)keyval);
              } else {
                wcsutil_double2str(kp, "%20.13f", keyval);
              }

              sscanf(fp+4, "%d", &p);
              if (p <= Nhat) {
                sprintf(comment, "Poly term %d: var %d power", m, p);
              } else {
                sprintf(comment, "Poly term %d: aux %d power", m, p-Nhat);
              }

            } else {
              wcsutil_double2str(kp, "%20.13E", keyval);
              sprintf(comment, "Poly term %d: coefficient", m);
            }
            strcat(keyvalue, "'");

            wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
              keyvalue, comment, nkeyrec, header, &status);
          }

          /* CPERRja/CQERRia */
          if (dis->maxdis[j] != 0.0) {
            sprintf(keyword,  "C%cERR%d", pq, j+1);
            sprintf(keyvalue, "%20.2f", dis->maxdis[j]);
            sprintf(comment, "%sMaximum absolute value of distortion",
              idis?"":"[pix] ");
            wcshdo_util(relax, keyword, "", 0, 0x0, 0, 0, 0, alt, 0, 0,
              keyvalue, comment, nkeyrec, header, &status);
          }
        }
d1355 1
a1355 1
  const double val[],
d1359 1
a1359 1
  char *cp, cval[24];
d1364 1
a1364 1
    cp = cval + 10;
d1366 1
a1366 1
      wcsutil_double2str(cval, "%20.10f", val[i]);
d1369 1
a1369 1
        if (cval[j] != ' ') {
d1378 1
a1378 1
    precision = cp - (cval + 10);
d1383 1
a1383 1
    cp = cval + 3;
d1385 1
a1385 1
      wcsutil_double2str(cval, "%20.13E", val[i]);
d1389 1
a1389 1
    precision = cp - cval - 3;
@


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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.c,v 4.25.1.4 2015/04/03 01:39:05 mcalabre Exp mcalabre $
@


5.0.1.1
log
@WCSLIB 5.0 development branch.
@
text
@d25 1
a25 1
  $Id: wcshdr.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: wcshdr.c,v 4.24.1.1 2014/09/18 15:28:09 mcalabre Exp mcalabre $
d33 2
a35 1
#include "wcsmath.h"
d51 10
d240 1
a240 2
      if (status == 3) status = 5;
      wcserr_set(WCSHDR_ERRMSG(status));
a699 1

d1059 15
a1073 11
  /* Double-up single-quotes in the keyvalue. */
  hptr = keyvalue + 1;
  while (*hptr) {
    if (*hptr == '\'') {
      kptr = hptr++;
      if (*hptr) {
        ch0 = *kptr;
        while (*kptr) {
          ch1 = *(++kptr);
          *kptr = ch0;
          ch0 = ch1;
d1076 9
d1087 6
a1092 1
    hptr++;
@


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


4.25.1.3
log
@in wcshdo_util(), fixed a bug in the code that doubles single quotes in
string keyvalues uncovered by valgrind.  Also check the length of keyvalues
and truncate if necessary.
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 4.25.1.2 2015/01/06 01:01:06 mcalabre Exp mcalabre $
d690 1
d1050 11
a1060 15
  /* Double-up single-quotes in string keyvalues. */
  if (*keyvalue == '\'') {
    hptr = keyvalue + 1;
    while (*hptr) {
      if (*hptr == '\'') {
        kptr = hptr++;
        if (*hptr) {
          ch0 = *kptr;
          while (*kptr) {
            ch1 = *(++kptr);
            *kptr = ch0;
            ch0 = ch1;
          }
        } else {
          break;
a1062 2

      hptr++;
d1065 1
a1065 13
    /* Check length. */
    if (strlen(keyvalue) > 70) {
      /* Truncate. */
      keyvalue[69] = '\'';
      keyvalue[70] = '\0';
    }

  } else {
    /* Check length. */
    if (strlen(keyvalue) > 70) {
      /* Truncate. */
      keyvalue[70] = '\0';
    }
@


4.25.1.4
log
@Created wcshdr_taberr[] to map status returns from the tab routines.
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 4.25.1.3 2015/03/06 02:52:20 mcalabre Exp mcalabre $
d33 1
a33 1
#include "wcserr.h"
a34 1
#include "wcsutil.h"
a49 10
/* Map error returns for lower-level routines. */
const int wcshdr_taberr[] = {
  WCSHDRERR_SUCCESS,		/*  0: TABERR_SUCCESS         */
  WCSHDRERR_NULL_POINTER,	/*  1: TABERR_NULL_POINTER    */
  WCSHDRERR_MEMORY,		/*  2: TABERR_MEMORY          */
  WCSHDRERR_BAD_TABULAR_PARAMS	/*  3: TABERR_BAD_PARAMS      */
				/*  4: TABERR_BAD_X           */
				/*  5: TABERR_BAD_WORLD       */
};

d229 2
a230 1
      status = wcserr_set(WCSHDR_ERRMSG(wcshdr_taberr[status]));
@


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: wcshdr.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: wcshdr.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: wcshdr.c,v 4.22.1.2 2014/05/04 14:18:47 mcalabre Exp mcalabre $
@


4.23.1.1
log
@WCSLIB 4.23 development branch.
@
text
@d25 1
a25 1
  $Id: wcshdr.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: wcshdr.c,v 4.21.1.1 2014/03/24 05:15:28 mcalabre Exp mcalabre $
d712 1
a712 1
  if (!undefined(wcs->restfrq)) {
d719 1
a719 1
  if (!undefined(wcs->restwav)) {
@


4.22.1.1
log
@WCSLIB 4.22 development branch.
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 4.22 2014/04/12 15:03:52 mcalabre Exp $
@


4.22.1.2
log
@In wcshdo(), don't write RESTFRQ or RESTWAV if equal to zero (the previous
test for them being defined was a mistake).
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 4.22.1.1 2014/04/12 15:06:32 mcalabre Exp mcalabre $
d712 1
a712 1
  if (wcs->restfrq != 0.0) {
d719 1
a719 1
  if (wcs->restwav != 0.0) {
@


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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.c,v 4.18.1.2 2013/09/29 08:46:10 mcalabre Exp $
@


4.19.1.1
log
@WCSLIB 4.19 development branch.
@
text
@d25 1
a25 1
  $Id: wcshdr.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: wcshdr.c,v 4.17.1.1 2013/01/29 05:32:32 cal103 Exp cal103 $
d591 1
d594 1
d597 1
@


4.18.1.1
log
@WCSLIB 4.18 development branch.
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 4.18 2013/07/13 10:00:04 mcalabre Exp $
@


4.18.1.2
log
@In wcshdo(), fixed a switch statement (uncovered by cppcheck, reported by
David Binderman).
@
text
@d25 1
a25 1
  $Id: wcshdr.c,v 4.18.1.1 2013/07/13 10:02:37 mcalabre Exp mcalabre $
a590 1
          break;
a592 1
          break;
a594 1
          break;
@


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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.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: wcshdr.c,v 4.14.1.1 2012/07/13 10:04:44 cal103 Exp cal103 $
@


4.15.1.1
log
@WCSLIB 4.15 development branch.
@
text
@d25 1
a25 1
  $Id: wcshdr.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: wcshdr.c,v 4.13.1.3 2012/07/13 03:34:20 cal103 Exp cal103 $
@


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


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: wcshdr.c,v 4.12.1.1 2012/02/29 07:59:10 cal103 Exp cal103 $
d528 1
a528 1
    sprintf(keyvalue, "%20.12G", wcs->crpix[j]);
d530 2
a531 2
      colnum, colax, keyvalue, "Pixel coordinate of reference point",
      nkeyrec, header, &status);
d544 1
a544 1
      sprintf(keyvalue, "%20.12G", wcs->pc[k]);
d546 2
a547 2
        bintab ? 0x0 : "PC", i+1, j+1, 0, alt, colnum, colax, keyvalue,
        "Coordinate transformation matrix element",
d554 1
a554 1
    sprintf(keyvalue, "%20.12G", wcs->cdelt[i]);
d634 1
a634 1
    sprintf(keyvalue, "%20.12G", wcs->crval[i]);
d644 1
a644 1
    sprintf(keyvalue, "%20.12G", (wcs->pv[k]).value);
d696 1
a696 1
    sprintf(keyvalue, "%20.12G", wcs->lonpole);
d703 1
a703 1
    sprintf(keyvalue, "%20.12G", wcs->latpole);
d710 1
a710 1
    sprintf(keyvalue, "%20.12G", wcs->restfrq);
d717 1
a717 1
    sprintf(keyvalue, "%20.12G", wcs->restwav);
d755 1
a755 1
      sprintf(keyvalue, "%20.12G", wcs->crder[i]);
d769 1
a769 1
      sprintf(keyvalue, "%20.12G", wcs->csyer[i]);
d788 1
a788 1
    sprintf(keyvalue, "%20.12G", wcs->equinox);
d812 1
a812 1
    sprintf(keyvalue, "%20.12G", wcs->velosys);
d828 1
a828 1
    sprintf(keyvalue, "%20.12G", wcs->zsource);
d838 1
a838 1
    sprintf(keyvalue, "%20.12G", wcs->obsgeo[k]);
d848 1
a848 1
    sprintf(keyvalue, "%20.12G", wcs->mjdobs);
d865 1
a865 1
    sprintf(keyvalue, "%20.12G", wcs->mjdavg);
@


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


4.13.1.2
log
@In wcshdo(), handle locales such as fr_FR where a comma is used to delimit
the decimal part of a floating point number.  Patch provided by Michael
Droettboom.
@
text
@d31 1
a31 1
  $Id: wcshdr.c,v 4.13.1.1 2012/03/14 07:40:37 cal103 Exp cal103 $
d534 1
a534 1
    wcsutil_double2str(keyvalue, "%20.12G", wcs->crpix[j]);
d536 2
a537 2
      colnum, colax, keyvalue, "Pixel coordinate of reference point", nkeyrec,
      header, &status);
d550 1
a550 1
      wcsutil_double2str(keyvalue, "%20.12G", wcs->pc[k]);
d552 2
a553 2
        bintab ? 0x0 : "PC", i+1, j+1, 0, alt, colnum, colax,
        keyvalue, "Coordinate transformation matrix element",
d560 1
a560 1
    wcsutil_double2str(keyvalue, "%20.12G", wcs->cdelt[i]);
d640 1
a640 1
    wcsutil_double2str(keyvalue, "%20.12G", wcs->crval[i]);
d650 1
a650 1
    wcsutil_double2str(keyvalue, "%20.12G", (wcs->pv[k]).value);
d702 1
a702 1
    wcsutil_double2str(keyvalue, "%20.12G", wcs->lonpole);
d709 1
a709 1
    wcsutil_double2str(keyvalue, "%20.12G", wcs->latpole);
d716 1
a716 1
    wcsutil_double2str(keyvalue, "%20.12G", wcs->restfrq);
d723 1
a723 1
    wcsutil_double2str(keyvalue, "%20.12G", wcs->restwav);
d761 1
a761 1
      wcsutil_double2str(keyvalue, "%20.12G", wcs->crder[i]);
d775 1
a775 1
      wcsutil_double2str(keyvalue, "%20.12G", wcs->csyer[i]);
d794 1
a794 1
    wcsutil_double2str(keyvalue, "%20.12G", wcs->equinox);
d818 1
a818 1
    wcsutil_double2str(keyvalue, "%20.12G", wcs->velosys);
d834 1
a834 1
    wcsutil_double2str(keyvalue, "%20.12G", wcs->zsource);
d844 1
a844 1
    wcsutil_double2str(keyvalue, "%20.12G", wcs->obsgeo[k]);
d854 1
a854 1
    wcsutil_double2str(keyvalue, "%20.12G", wcs->mjdobs);
d871 1
a871 1
    wcsutil_double2str(keyvalue, "%20.12G", wcs->mjdavg);
@


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: wcshdr.c,v 4.13.1.2 2012/07/12 15:19:16 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: wcshdr.c,v 4.11.1.1 2012/02/20 23:31:13 cal103 Exp cal103 $
@


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


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


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


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


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


4.9
log
@WCSLIB 4.9
@
text
@d3 1
a3 1
  WCSLIB 4.9 - an implementation of the FITS WCS standard.
d31 1
a31 1
  $Id: wcshdr.c,v 4.8.1.2 2012/01/24 05:23:06 cal103 Exp cal103 $
@


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


4.8
log
@WCSLIB 4.8
@
text
@d3 2
a4 2
  WCSLIB 4.8 - an implementation of the FITS WCS standard.
  Copyright (C) 1995-2011, Mark Calabretta
d31 1
a31 1
  $Id: wcshdr.c,v 4.7.1.4 2011/08/10 06:28:04 cal103 Exp cal103 $
@


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


4.8.1.2
log
@Updated date in copyright notice.
@
text
@d4 1
a4 1
  Copyright (C) 1995-2012, Mark Calabretta
d31 1
a31 1
  $Id: wcshdr.c,v 4.8.1.1 2011/08/15 08:07:06 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: wcshdr.c,v 4.6.1.2 2011/01/14 06:33:16 cal103 Exp cal103 $
d52 3
a54 2
  "Invalid tabular parameters",
  "Fatal error returned by Flex parser"};
d56 5
a60 2
void wcshdo_util(int, const char [], const char [], int, const char [], int,
  int, int, char, int, int [], char [], const char [], int *, char **,
d68 2
d75 1
d77 2
a80 2
  if (wcs == 0x0) return 1;

d104 1
a104 1
    return 2;
d134 1
a134 1
    status = 2;
d193 2
a194 1
      status = 3;
d218 1
a218 1
    status = 2;
d235 2
d261 2
a262 1
        status = 3;
d284 1
a284 1
    status = 2;
d375 1
a375 1
    return 1;
d412 1
a412 1
    return 1;
d459 1
a459 1
    return 1;
d482 2
d488 1
d493 2
a494 3
  if (wcs == 0x0) {
    return 1;
  }
d927 3
d963 1
a963 1
      *status = 2;
@


4.7.1.1
log
@WCSLIB 4.7 development branch.
@
text
@d31 1
a31 1
  $Id: wcshdr.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
@d72 1
a72 1
  if (wcs == 0x0) return WCSHDRERR_NULL_POINTER;
d97 1
a97 1
    return WCSERR_SET(&wcs->err, WCSHDRERR_MEMORY, wcshdr_errmsg[WCSHDRERR_MEMORY]);
d127 1
a127 1
    status = WCSERR_SET(&wcs->err, WCSHDRERR_MEMORY, wcshdr_errmsg[WCSHDRERR_MEMORY]);
d186 1
a186 4
      /* ERRTODO: Better error message */
      status = WCSERR_SET(
        &wcs->err, WCSHDRERR_BAD_TABULAR_PARAMS,
        wcshdr_errmsg[WCSHDRERR_BAD_TABULAR_PARAMS]);
d210 1
a210 1
    status = WCSERR_SET(&wcs->err, WCSHDRERR_MEMORY, wcshdr_errmsg[WCSHDRERR_MEMORY]);
a226 1
      wcserr_copy(&wcs->err, &((wcs->tab + itab)->err));
d251 1
a251 4
        /* ERRTODO: Better error message */
        status = WCSERR_SET(
          &wcs->err, WCSHDRERR_BAD_TABULAR_PARAMS,
          wcshdr_errmsg[WCSHDRERR_BAD_TABULAR_PARAMS]);
d273 1
a273 1
    status = WCSERR_SET(&wcs->err, WCSHDRERR_MEMORY, wcshdr_errmsg[WCSHDRERR_MEMORY]);
d364 1
a364 1
    return WCSHDRERR_NULL_POINTER;
d401 1
a401 1
    return WCSHDRERR_NULL_POINTER;
d448 1
a448 1
    return WCSHDRERR_NULL_POINTER;
d480 1
a480 1
    return WCSHDRERR_NULL_POINTER;
a913 3
  if (status == WCSHDRERR_MEMORY) {
    WCSERR_SET(&wcs->err, WCSHDRERR_MEMORY, wcshdr_errmsg[WCSHDRERR_MEMORY]);
  }
d947 1
a947 1
      *status = WCSHDRERR_MEMORY;
@


4.7.1.3
log
@Revised implementation of Michael Droettboom's error messaging system.
@
text
@d31 1
a31 1
  $Id: wcshdr.c,v 4.7.1.1 2011/02/07 07:04:22 cal103 Exp cal103 $
a54 3
/* Convenience macro for invoking wcserr_set(). */
#define WCSHDR_ERRMSG(status) WCSERR_SET(status), wcshdr_errmsg[status]

a63 2
  static const char *function = "wcstab";

a68 1
  struct wcserr **err;
d70 2
a72 1
  err = &(wcs->err);
a73 1
  /* Free memory previously allocated by wcstab(). */
d97 1
a97 1
    return wcserr_set(WCSHDR_ERRMSG(WCSHDRERR_MEMORY));
d127 1
a127 1
    status = wcserr_set(WCSHDR_ERRMSG(WCSHDRERR_MEMORY));
d186 4
a189 2
      status = wcserr_set(WCSERR_SET(WCSHDRERR_BAD_TABULAR_PARAMS),
        "Invalid tabular parameters: PSi_0a and PSi_1a must be specified");
d213 1
a213 1
    status = wcserr_set(WCSHDR_ERRMSG(WCSHDRERR_MEMORY));
d230 1
a230 1
      wcserr_set(WCSHDR_ERRMSG(status));
d255 4
a258 2
        status = wcserr_set(WCSERR_SET(WCSHDRERR_BAD_TABULAR_PARAMS),
          "Invalid tabular parameters: the axis mapping is undefined");
d280 1
a280 1
    status = wcserr_set(WCSHDR_ERRMSG(WCSHDRERR_MEMORY));
a477 2
  static const char *function = "wcshdo";

a481 1
  struct wcserr **err;
d486 3
a488 2
  if (wcs == 0x0) return WCSHDRERR_NULL_POINTER;
  err = &(wcs->err);
d922 1
a922 1
    wcserr_set(WCSHDR_ERRMSG(status));
@


4.7.1.4
log
@Fixed a long-standing inconsistency in the meaning of status == 3 returned
from wcsbth() and wcstab().  Declared wcshdo_util() static.
@
text
@d31 1
a31 1
  $Id: wcshdr.c,v 4.7.1.3 2011/08/09 02:43:50 cal103 Exp cal103 $
d52 2
a53 3
  "Invalid column selection",
  "Fatal error returned by Flex parser",
  "Invalid tabular parameters"};
d58 2
a59 2
static void wcshdo_util(int, const char [], const char [], int, const char [],
  int, int, int, char, int, int [], char [], const char [], int *, char **,
a233 1
      if (status == 3) status = 5;
@


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: wcshdr.c,v 4.5.1.2 2010/09/28 01:52:45 cal103 Exp cal103 $
@


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


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: wcshdr.c,v 4.4.1.2 2010/01/19 03:42:50 cal103 Exp cal103 $
d521 1
a521 1
    sprintf(keyvalue, "%20.12g", wcs->crpix[j]);
d537 1
a537 1
      sprintf(keyvalue, "%20.12g", wcs->pc[k]);
d547 1
a547 1
    sprintf(keyvalue, "%20.12g", wcs->cdelt[i]);
d627 1
a627 1
    sprintf(keyvalue, "%20.12g", wcs->crval[i]);
d637 1
a637 1
    sprintf(keyvalue, "%20.12g", (wcs->pv[k]).value);
d689 1
a689 1
    sprintf(keyvalue, "%20.12g", wcs->lonpole);
d696 1
a696 1
    sprintf(keyvalue, "%20.12g", wcs->latpole);
d703 1
a703 1
    sprintf(keyvalue, "%20.12g", wcs->restfrq);
d710 1
a710 1
    sprintf(keyvalue, "%20.12g", wcs->restwav);
d748 1
a748 1
      sprintf(keyvalue, "%20.12g", wcs->crder[i]);
d762 1
a762 1
      sprintf(keyvalue, "%20.12g", wcs->csyer[i]);
d781 1
a781 1
    sprintf(keyvalue, "%20.12g", wcs->equinox);
d805 1
a805 1
    sprintf(keyvalue, "%20.12g", wcs->velosys);
d821 1
a821 1
    sprintf(keyvalue, "%20.12g", wcs->zsource);
d831 1
a831 1
    sprintf(keyvalue, "%20.12g", wcs->obsgeo[k]);
d841 1
a841 1
    sprintf(keyvalue, "%20.12g", wcs->mjdobs);
d858 1
a858 1
    sprintf(keyvalue, "%20.12g", wcs->mjdavg);
@


4.5.1.1
log
@WCSLIB 4.5 development branch.
@
text
@d31 1
a31 1
  $Id: wcshdr.c,v 4.5 2010/07/16 07:01:25 cal103 Exp $
@


4.5.1.2
log
@In wcshdo(), according to the FITS standard, "Letters in the exponential
form ('E' or 'D') shall be upper case".  Reported by Michael Droettboom.
@
text
@d31 1
a31 1
  $Id: wcshdr.c,v 4.5.1.1 2010/07/16 07:05:31 cal103 Exp cal103 $
d521 1
a521 1
    sprintf(keyvalue, "%20.12G", wcs->crpix[j]);
d537 1
a537 1
      sprintf(keyvalue, "%20.12G", wcs->pc[k]);
d547 1
a547 1
    sprintf(keyvalue, "%20.12G", wcs->cdelt[i]);
d627 1
a627 1
    sprintf(keyvalue, "%20.12G", wcs->crval[i]);
d637 1
a637 1
    sprintf(keyvalue, "%20.12G", (wcs->pv[k]).value);
d689 1
a689 1
    sprintf(keyvalue, "%20.12G", wcs->lonpole);
d696 1
a696 1
    sprintf(keyvalue, "%20.12G", wcs->latpole);
d703 1
a703 1
    sprintf(keyvalue, "%20.12G", wcs->restfrq);
d710 1
a710 1
    sprintf(keyvalue, "%20.12G", wcs->restwav);
d748 1
a748 1
      sprintf(keyvalue, "%20.12G", wcs->crder[i]);
d762 1
a762 1
      sprintf(keyvalue, "%20.12G", wcs->csyer[i]);
d781 1
a781 1
    sprintf(keyvalue, "%20.12G", wcs->equinox);
d805 1
a805 1
    sprintf(keyvalue, "%20.12G", wcs->velosys);
d821 1
a821 1
    sprintf(keyvalue, "%20.12G", wcs->zsource);
d831 1
a831 1
    sprintf(keyvalue, "%20.12G", wcs->obsgeo[k]);
d841 1
a841 1
    sprintf(keyvalue, "%20.12G", wcs->mjdobs);
d858 1
a858 1
    sprintf(keyvalue, "%20.12G", wcs->mjdavg);
@


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: wcshdr.c,v 4.3.1.3 2009/07/22 04:28:39 cal103 Exp cal103 $
@


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


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


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: wcshdr.c,v 4.2.1.12 2007/12/27 05:14:15 cal103 Exp cal103 $
d49 5
a53 4
   "Success",
   "Null wcsprm pointer passed",
   "Memory allocation failed",
   "Invalid tabular parameters"};
d56 2
a57 2
   int, int, char, int, int [], char [], const char [], int *, char **,
   int *);
d64 123
a186 51
   char (*PSi_0a)[72] = 0x0, (*PSi_1a)[72] = 0x0, (*PSi_2a)[72] = 0x0;
   int  *PVi_1a = 0x0, *PVi_2a = 0x0, *PVi_3a = 0x0, *tabax, *tabidx = 0x0;
   int   getcrd, i, ip, itab, itabax, j, jtabax, m, naxis, ntabax, status;
   struct wtbarr *wtbp;
   struct tabprm *tabp;


   /* Free memory previously allocated by wcstab(). */
   if (wcs == 0x0) return 1;

   if (wcs->flag != -1 && wcs->m_flag == WCSSET) {
      if (wcs->wtb == wcs->m_wtb) wcs->wtb = 0x0;
      if (wcs->tab == wcs->m_tab) wcs->tab = 0x0;

      if (wcs->m_wtb) free(wcs->m_wtb);
      if (wcs->m_tab) {
         for (j = 0; j < wcs->ntab; j++) {
            tabfree(wcs->m_tab + j);
         }

         free(wcs->m_tab);
      }
   }

   wcs->ntab = 0;
   wcs->nwtb = 0;
   wcs->wtb  = 0x0;
   wcs->tab  = 0x0;


   /* Determine the number of -TAB axes. */
   naxis = wcs->naxis;
   if (!(tabax = calloc(naxis, sizeof(int)))) {
      return 2;
   }

   ntabax = 0;
   for (i = 0; i < naxis; i++) {
      /* Null fill. */
      wcsutil_null_fill(72, wcs->ctype[i]);

      if (!strcmp(wcs->ctype[i]+4, "-TAB")) {
         tabax[i] = ntabax++;
      } else {
         tabax[i] = -1;
      }
   }

   if (ntabax == 0) {
      /* No lookup tables. */
      status = 0;
d188 1
a188 1
   }
d190 34
d225 2
a226 9
   /* Collect information from the PSi_ma and PVi_ma keyvalues. */
   if (!((PSi_0a = calloc(ntabax, sizeof(char[72]))) &&
         (PVi_1a = calloc(ntabax, sizeof(int)))      &&
         (PVi_2a = calloc(ntabax, sizeof(int)))      &&
         (PSi_1a = calloc(ntabax, sizeof(char[72]))) &&
         (PSi_2a = calloc(ntabax, sizeof(char[72]))) &&
         (PVi_3a = calloc(ntabax, sizeof(int)))      &&
         (tabidx = calloc(ntabax, sizeof(int))))) {
      status = 2;
d228 2
a229 1
   }
a230 77
   for (itabax = 0; itabax < ntabax; itabax++) {
      /* Remember that calloc() zeroes allocated memory. */
      PVi_1a[itabax] = 1;
      PVi_2a[itabax] = 1;
      PVi_3a[itabax] = 1;
   }

   for (ip = 0; ip < wcs->nps; ip++) {
      itabax = tabax[wcs->ps[ip].i - 1];
      if (itabax >= 0) {
         switch (wcs->ps[ip].m) {
         case 0:
            /* EXTNAME. */
            strcpy(PSi_0a[itabax], wcs->ps[ip].value);
            wcsutil_null_fill(72, PSi_0a[itabax]);
            break;
         case 1:
            /* TTYPEn for coordinate array. */
            strcpy(PSi_1a[itabax], wcs->ps[ip].value);
            wcsutil_null_fill(72, PSi_1a[itabax]);
            break;
         case 2:
            /* TTYPEn for index vector. */
            strcpy(PSi_2a[itabax], wcs->ps[ip].value);
            wcsutil_null_fill(72, PSi_2a[itabax]);
            break;
         }
      }
   }

   for (ip = 0; ip < wcs->npv; ip++) {
      itabax = tabax[wcs->pv[ip].i - 1];
      if (itabax >= 0) {
         switch (wcs->pv[ip].m) {
         case 1:
            /* EXTVER. */
            PVi_1a[itabax] = (int)(wcs->pv[ip].value + 0.5);
            break;
         case 2:
            /* EXTLEVEL. */
            PVi_2a[itabax] = (int)(wcs->pv[ip].value + 0.5);
            break;
         case 3:
            /* Table axis number. */
            PVi_3a[itabax] = (int)(wcs->pv[ip].value + 0.5);
            break;
         }
      }
   }


   /* Determine the number of independent tables. */
   for (itabax = 0; itabax < ntabax; itabax++) {
      /* These have no defaults. */
      if (!PSi_0a[itabax][0] || !PSi_1a[itabax][0]) {
         status = 3;
         goto cleanup;
      }

      tabidx[itabax] = -1;
      for (jtabax = 0; jtabax < i; jtabax++) {
         /* EXTNAME, EXTVER, EXTLEVEL, and TTYPEn for the coordinate array */
         /* must match for each axis of a multi-dimensional lookup table.  */
         if (strcmp(PSi_0a[itabax], PSi_0a[jtabax]) == 0 &&
             strcmp(PSi_1a[itabax], PSi_1a[jtabax]) == 0 &&
             PVi_1a[itabax] == PVi_1a[jtabax] &&
             PVi_2a[itabax] == PVi_2a[jtabax]) {
            tabidx[itabax] = tabidx[jtabax];
            break;
         }
      }

      if (jtabax == itabax) {
         tabidx[itabax] = wcs->ntab;
         wcs->ntab++;
      }
   }
d232 67
a298 5
   if (!(wcs->tab = calloc(wcs->ntab, sizeof(struct tabprm)))) {
      status = 2;
      goto cleanup;
   }
   wcs->m_tab = wcs->tab;
d300 2
a301 3
   /* Table dimensionality; find the largest axis number. */
   for (itabax = 0; itabax < ntabax; itabax++) {
      tabp = wcs->tab + tabidx[itabax];
d303 2
a304 3
      /* PVi_3a records the 1-relative table axis number. */
      if (PVi_3a[itabax] > tabp->M) {
         tabp->M = PVi_3a[itabax];
a305 1
   }
a306 36
   for (itab = 0; itab < wcs->ntab; itab++) {
      if ((status = tabini(1, wcs->tab[itab].M, 0, wcs->tab + itab))) {
         goto cleanup;
      }
   }


   /* Copy parameters into the tabprm structs. */
   for (i = 0; i < naxis; i++) {
      if ((itabax = tabax[i]) < 0) {
         /* Not a -TAB axis. */
         continue;
      }

      /* PVi_3a records the 1-relative table axis number. */
      m = PVi_3a[itabax] - 1;

      tabp = wcs->tab + tabidx[itabax];
      tabp->map[m] = i;
      tabp->crval[m] = wcs->crval[i];
   }

   /* Check for completeness. */
   for (itab = 0; itab < wcs->ntab; itab++) {
      for (m = 0; m < wcs->tab[itab].M; m++) {
         if (wcs->tab[itab].map[m] < 0) {
            status = 3;
            goto cleanup;
         }
      }
   }


   /* Set up for reading the arrays; how many arrays are there? */
   for (itabax = 0; itabax < ntabax; itabax++) {
      /* Does this -TAB axis have a non-degenerate index array? */
d308 17
a324 10
         wcs->nwtb++;
      }
   }

   /* Add one coordinate array for each table. */
   wcs->nwtb += wcs->ntab;

   /* Allocate memory for structs to be returned. */
   if (!(wcs->wtb = calloc(wcs->nwtb, sizeof(struct wtbarr)))) {
      wcs->nwtb = 0;
d326 1
a326 55
      status = 2;
      goto cleanup;
   }
   wcs->m_wtb = wcs->wtb;

   /* Set pointers for the index and coordinate arrays. */
   wtbp = wcs->wtb;
   for (itab = 0; itab < wcs->ntab; itab++) {
      getcrd = 1;
      for (itabax = 0; itabax < ntabax; itabax++) {
         if (tabidx[itabax] != itab) continue;

         if (getcrd) {
            /* Coordinate array. */
            wtbp->i = itabax + 1;
            wtbp->m = PVi_3a[itabax];
            wtbp->kind = 'c';

            strcpy(wtbp->extnam, PSi_0a[itabax]);
            wtbp->extver = PVi_1a[itabax];
            wtbp->extlev = PVi_2a[itabax];
            strcpy(wtbp->ttype, PSi_1a[itabax]);
            wtbp->row    = 1L;
            wtbp->ndim   = wcs->tab[itab].M + 1;
            wtbp->dimlen = wcs->tab[itab].K;
            wtbp->arrayp = &(wcs->tab[itab].coord);

            /* Signal for tabset() to take this memory. */
            wcs->tab[itab].m_coord = (double *)0x1;

            wtbp++;
            getcrd = 0;
         }

         if (PSi_2a[itabax][0]) {
            /* Index array. */
            wtbp->i = itabax + 1;
            wtbp->m = PVi_3a[itabax];
            wtbp->kind = 'i';

            m = wtbp->m - 1;
            strcpy(wtbp->extnam, PSi_0a[itabax]);
            wtbp->extver = PVi_1a[itabax];
            wtbp->extlev = PVi_2a[itabax];
            strcpy(wtbp->ttype, PSi_2a[itabax]);
            wtbp->row    = 1L;
            wtbp->ndim   = 1;
            wtbp->dimlen = wcs->tab[itab].K + m;
            wtbp->arrayp = wcs->tab[itab].index + m;

            /* Signal for tabset() to take this memory. */
            wcs->tab[itab].m_indxs[m] = (double *)0x1;

            wtbp++;
         }
d328 2
a329 1
   }
d331 1
a331 1
   status = 0;
d334 13
a346 13
   if (tabax)  free(tabax);
   if (tabidx) free(tabidx);
   if (PSi_0a) free(PSi_0a);
   if (PVi_1a) free(PVi_1a);
   if (PVi_2a) free(PVi_2a);
   if (PSi_1a) free(PSi_1a);
   if (PSi_2a) free(PSi_2a);
   if (PVi_3a) free(PVi_3a);

   if (status) {
      if (wcs->tab) free(wcs->tab);
      if (wcs->wtb) free(wcs->wtb);
   }
d348 1
a348 1
   return status;
d356 2
a357 2
   int a, iwcs;
   struct wcsprm *wcsp;
d359 17
a375 11
   for (a = 0; a < 27; a++) {
      alts[a] = -1;
   }

   if (wcs == 0x0) {
      return 1;
   }

   wcsp = *wcs;
   for (iwcs = 0; iwcs < nwcs; iwcs++, wcsp++) {
      if (wcsp->colnum || wcsp->colax[0]) continue;
d377 2
a378 8
      if (wcsp->alt[0] == ' ') {
         a = 0;
      } else {
         a = wcsp->alt[0] - 'A' + 1;
      }

      alts[a] = iwcs;
   }
d380 1
a380 1
   return 0;
d388 34
a421 22
   short  *ip;
   int    a, i, icol, iwcs;
   struct wcsprm *wcsp;

   for (ip = alts[0]; ip < alts[0] + 28*1000; ip++) {
      *ip = -1;
   }

   for (icol = 0; icol < 1000; icol++) {
      alts[icol][27] = 0;
   }

   if (wcs == 0x0) {
      return 1;
   }

   wcsp = *wcs;
   for (iwcs = 0; iwcs < nwcs; iwcs++, wcsp++) {
      if (wcsp->alt[0] == ' ') {
         a = 0;
      } else {
         a = wcsp->alt[0] - 'A' + 1;
d424 8
a431 21
      if (type) {
         /* Pixel list. */
         if (wcsp->colax[0]) {
            for (i = 0; i < wcsp->naxis; i++) {
               alts[wcsp->colax[i]][a]  = iwcs;
               alts[wcsp->colax[i]][27]++;
            }
         } else if (!wcsp->colnum) {
            alts[0][a]  = iwcs;
            alts[0][27]++;
         }

      } else {
         /* Binary table image array. */
         if (wcsp->colnum) {
           alts[wcsp->colnum][a] = iwcs;
           alts[wcsp->colnum][27]++;
         } else if (!wcsp->colax[0]) {
            alts[0][a]  = iwcs;
            alts[0][27]++;
         }
d433 2
a434 1
   }
d436 1
a436 1
   return 0;
d444 2
a445 2
   int a, status = 0;
   struct wcsprm *wcsp;
d447 3
a449 3
   if (wcs == 0x0) {
      return 1;
   }
d451 4
a454 4
   wcsp = *wcs;
   for (a = 0; a < *nwcs; a++, wcsp++) {
      status |= wcsfree(wcsp);
   }
d456 1
a456 1
   free(*wcs);
d458 2
a459 2
   *nwcs = 0;
   *wcs = 0x0;
d461 1
a461 1
   return status;
d471 278
a748 78
   char alt, comment[72], keyvalue[72], keyword[16], obsg[8] = "OBSG?",
        obsgeo[8] = "OBSGEO-?", ptype, xtype, xyz[] = "XYZ";
   int  bintab, col0, *colax, colnum, i, j, k, naxis, pixlist, primage,
        status = 0;

   *nkeyrec = 0;
   *header  = 0x0;

   if (wcs == 0x0) {
      return 1;
   }

   if (wcs->flag != WCSSET) {
      if ((status = wcsset(wcs))) return status;
   }

   if ((naxis = wcs->naxis) == 0) {
      return 0;
   }


   /* These are mainly for convenience. */
   alt = wcs->alt[0];
   if (alt == ' ') alt = '\0';
   colnum = wcs->colnum;
   colax  = wcs->colax;

   primage = 0;
   bintab  = 0;
   pixlist = 0;
   if (colnum) {
      bintab  = 1;
      col0 = colnum;
   } else if (colax[0]) {
      pixlist = 1;
      col0 = colax[0];
   } else {
      primage = 1;
   }


   /* WCS dimension. */
   if (!pixlist) {
      sprintf(keyvalue, "%20d", naxis);
      wcshdo_util(relax, "WCSAXES", "WCAX", 0, 0x0, 0, 0, 0, alt,
         colnum, colax, keyvalue, "Number of coordinate axes",
         nkeyrec, header, &status);
   }

   /* Reference pixel coordinates. */
   for (j = 0; j < naxis; j++) {
      sprintf(keyvalue, "%20.12g", wcs->crpix[j]);
      wcshdo_util(relax, "CRPIX", "CRP", WCSHDO_CRPXna, "CRPX", 0, j+1, 0,
         alt, colnum, colax, keyvalue, "Pixel coordinate of reference point",
         nkeyrec, header, &status);
   }

   /* Linear transformation matrix. */
   k = 0;
   for (i = 0; i < naxis; i++) {
      for (j = 0; j < naxis; j++, k++) {
         if (i == j) {
           if (wcs->pc[k] == 1.0) continue;
         } else {
           if (wcs->pc[k] == 0.0) continue;
         }

         sprintf(keyvalue, "%20.12g", wcs->pc[k]);
         wcshdo_util(relax, "PC", bintab ? "PC" : "P", WCSHDO_TPCn_ka,
            bintab ? 0x0 : "PC", i+1, j+1, 0, alt, colnum, colax, keyvalue,
            "Coordinate transformation matrix element",
            nkeyrec, header, &status);
      }
   }

   /* Coordinate increment at reference point. */
   for (i = 0; i < naxis; i++) {
      sprintf(keyvalue, "%20.12g", wcs->cdelt[i]);
d751 12
a762 78
      strcat(comment, "Coordinate increment at reference point");
      wcshdo_util(relax, "CDELT", "CDE", WCSHDO_CRPXna, "CDLT", i+1, 0, 0,
         alt, colnum, colax, keyvalue, comment, nkeyrec, header, &status);
   }

   /* Units of coordinate increment and reference value. */
   for (i = 0; i < naxis; i++) {
      if (wcs->cunit[i][0] == '\0') continue;

      sprintf(keyvalue, "'%s'", wcs->cunit[i]);
      wcshdo_util(relax, "CUNIT", "CUN", WCSHDO_CRPXna, "CUNI", i+1, 0, 0,
         alt, colnum, colax, keyvalue,
         "Units of coordinate increment and value", nkeyrec, header, &status);
   }

   /* Coordinate type. */
   for (i = 0; i < naxis; i++) {
      if (wcs->ctype[i][0] == '\0') continue;

      sprintf(keyvalue, "'%s'", wcs->ctype[i]);
      strcpy(comment, "Coordinate type code");
      if (i == wcs->lng || i == wcs->lat) {
         if (strncmp(wcs->ctype[i], "RA--", 4) == 0) {
            strcpy(comment, "Right ascension, ");
         } else if (strncmp(wcs->ctype[i], "DEC-", 4) == 0) {
            strcpy(comment, "Declination, ");
         } else if (strncmp(wcs->ctype[i]+1, "LON", 3) == 0 ||
                    strncmp(wcs->ctype[i]+1, "LAT", 3) == 0) {
            switch (wcs->ctype[i][0]) {
            case 'G':
               strcpy(comment, "galactic ");
               break;
            case 'E':
               strcpy(comment, "ecliptic ");
            case 'H':
               strcpy(comment, "helioecliptic ");
            case 'S':
               strcpy(comment, "supergalactic ");
            }

            if (i == wcs->lng) {
               strcat(comment, "longitude, ");
            } else {
               strcat(comment, "latitude, ");
            }

            wcs->ctype[i][0] = toupper(wcs->ctype[i][0]);
         }

         strcat(comment, wcs->cel.prj.name);
         strcat(comment, " projection");

      } else if (i == wcs->spec) {
         spctyp(wcs->ctype[i], 0x0, 0x0, comment, 0x0, &ptype, &xtype, 0x0);
         if (ptype == xtype) {
            strcat(comment, " (linear)");
         } else {
            switch (xtype) {
            case 'F':
               strcat(comment, " (linear in frequency)");
               break;
            case 'V':
               strcat(comment, " (linear in velocity)");
               break;
            case 'W':
               strcat(comment, " (linear in wavelength)");
               break;
            }
         }
      }

      wcshdo_util(relax, "CTYPE", "CTY", WCSHDO_CRPXna, "CTYP", i+1, 0, 0,
         alt, colnum, colax, keyvalue, comment, nkeyrec, header, &status);
   }

   /* Coordinate value at reference point. */
   for (i = 0; i < naxis; i++) {
      sprintf(keyvalue, "%20.12g", wcs->crval[i]);
d765 99
a863 39
      strcat(comment, "Coordinate value at reference point");
      wcshdo_util(relax, "CRVAL", "CRV", WCSHDO_CRPXna, "CRVL", i+1, 0, 0,
         alt, colnum, colax, keyvalue, comment, nkeyrec, header, &status);
   }

   /* Parameter values. */
   for (k = 0; k < wcs->npv; k++) {
      sprintf(keyvalue, "%20.12g", (wcs->pv[k]).value);
      if ((wcs->pv[k]).i == (wcs->lng + 1)) {
         switch ((wcs->pv[k]).m) {
         case 1:
            strcpy(comment, "[deg] Native longitude of the reference point");
            break;
         case 2:
            strcpy(comment, "[deg] Native latitude  of the reference point");
            break;
         case 3:
            if (primage) {
               sprintf(keyword, "LONPOLE%c", alt);
            } else if (bintab) {
               sprintf(keyword, "LONP%d%c", colnum, alt);
            } else {
               sprintf(keyword, "LONP%d%c", colax[(wcs->pv[k]).i - 1], alt);
            }
            sprintf(comment, "[deg] alias for %s (has precedence)", keyword);
            break;
         case 4:
            if (primage) {
               sprintf(keyword, "LATPOLE%c", alt);
            } else if (bintab) {
               sprintf(keyword, "LATP%d%c", colnum, alt);
            } else {
               sprintf(keyword, "LATP%d%c", colax[(wcs->pv[k]).i - 1], alt);
            }
            sprintf(comment, "[deg] alias for %s (has precedence)", keyword);
            break;
         }
      } else if ((wcs->pv[k]).i == (wcs->lat + 1)) {
        sprintf(comment, "%s projection parameter", wcs->cel.prj.code);
d865 1
a865 1
        strcpy(comment, "Coordinate transformation parameter");
d867 1
d869 12
a880 50
      wcshdo_util(relax, "PV", "V", WCSHDO_PVn_ma, "PV", wcs->pv[k].i, -1,
         wcs->pv[k].m, alt, colnum, colax, keyvalue, comment,
         nkeyrec, header, &status);
   }

   for (k = 0; k < wcs->nps; k++) {
      sprintf(keyvalue, "'%s'", (wcs->ps[k]).value);

      wcshdo_util(relax, "PS", "S", WCSHDO_PVn_ma, "PS", wcs->ps[k].i, -1,
         wcs->ps[k].m, alt, colnum, colax, keyvalue,
         "Coordinate transformation parameter",
         nkeyrec, header, &status);
   }

   /* Celestial and spectral transformation parameters. */
   if (!undefined(wcs->lonpole)) {
      sprintf(keyvalue, "%20.12g", wcs->lonpole);
      wcshdo_util(relax, "LONPOLE", "LONP", 0, 0x0, 0, 0, 0, alt,
         colnum, colax, keyvalue, "[deg] Native longitude of celestial pole",
         nkeyrec, header, &status);
   }

   if (!undefined(wcs->latpole)) {
      sprintf(keyvalue, "%20.12g", wcs->latpole);
      wcshdo_util(relax, "LATPOLE", "LATP", 0, 0x0, 0, 0, 0, alt,
         colnum, colax, keyvalue, "[deg] Native latitude of celestial pole",
         nkeyrec, header, &status);
   }

   if (!undefined(wcs->restfrq)) {
      sprintf(keyvalue, "%20.12g", wcs->restfrq);
      wcshdo_util(relax, "RESTFRQ", "RFRQ", 0, 0x0, 0, 0, 0, alt,
         colnum, colax, keyvalue, "[Hz] Line rest frequency",
         nkeyrec, header, &status);
   }

   if (!undefined(wcs->restwav)) {
      sprintf(keyvalue, "%20.12g", wcs->restwav);
      wcshdo_util(relax, "RESTWAV", "RWAV", 0, 0x0, 0, 0, 0, alt,
         colnum, colax, keyvalue, "[Hz] Line rest wavelength",
         nkeyrec, header, &status);
   }

   /* Coordinate system title. */
   if (wcs->wcsname[0]) {
      sprintf(keyvalue, "'%s'", wcs->wcsname);
      if (bintab) {
         wcshdo_util(relax, "WCSNAME", "WCSN", 0, 0x0, 0, 0, 0, alt,
            colnum, colax, keyvalue, "Coordinate system title",
            nkeyrec, header, &status);
d882 23
a904 166
         /* TWCS was a mistake. */
         wcshdo_util(relax, "WCSNAME", "TWCS", WCSHDO_WCSNna, "WCSN", 0, 0, 0,
            alt, colnum, colax, keyvalue, "Coordinate system title",
            nkeyrec, header, &status);
      }
   }

   /* Coordinate axis title. */
   if (wcs->cname) {
      for (i = 0; i < naxis; i++) {
         if (wcs->cname[i][0] == '\0') continue;

         sprintf(keyvalue, "'%s'", wcs->cname[i]);
         wcshdo_util(relax, "CNAME", "CNA", WCSHDO_CNAMna, "CNAM", i+1, 0, 0,
            alt, colnum, colax, keyvalue, "Axis name for labelling purposes",
            nkeyrec, header, &status);
      }
   }

   /* Random error in coordinate. */
   if (wcs->crder) {
      for (i = 0; i < naxis; i++) {
         if (undefined(wcs->crder[i])) continue;

         sprintf(keyvalue, "%20.12g", wcs->crder[i]);
         comment[0] = '\0';
         if (wcs->cunit[i][0]) sprintf(comment, "[%s] ", wcs->cunit[i]);
         strcat(comment, "Random error in coordinate");
         wcshdo_util(relax, "CRDER", "CRD", WCSHDO_CNAMna, "CRDE", i+1, 0, 0,
            alt, colnum, colax, keyvalue, comment, nkeyrec, header, &status);
      }
   }

   /* Systematic error in coordinate. */
   if (wcs->csyer) {
      for (i = 0; i < naxis; i++) {
         if (undefined(wcs->csyer[i])) continue;

         sprintf(keyvalue, "%20.12g", wcs->csyer[i]);
         comment[0] = '\0';
         if (wcs->cunit[i][0]) sprintf(comment, "[%s] ", wcs->cunit[i]);
         strcat(comment, "Systematic error in coordinate");
         wcshdo_util(relax, "CSYER", "CSY", WCSHDO_CNAMna, "CSYE", i+1, 0, 0,
            alt, colnum, colax, keyvalue, comment, nkeyrec, header, &status);
      }
   }

   /* Equatorial coordinate system type. */
   if (wcs->radesys[0]) {
      sprintf(keyvalue, "'%s'", wcs->radesys);
      wcshdo_util(relax, "RADESYS", "RADE", 0, 0x0, 0, 0, 0, alt,
         colnum, colax, keyvalue, "Equatorial coordinate system",
         nkeyrec, header, &status);
   }

   /* Equinox of equatorial coordinate system. */
   if (!undefined(wcs->equinox)) {
      sprintf(keyvalue, "%20.12g", wcs->equinox);
      wcshdo_util(relax, "EQUINOX", "EQUI", 0, 0x0, 0, 0, 0, alt,
         colnum, colax, keyvalue, "[yr] Equinox of equatorial coordinates",
         nkeyrec, header, &status);
   }

   /* Reference frame of spectral coordinates. */
   if (wcs->specsys[0]) {
      sprintf(keyvalue, "'%s'", wcs->specsys);
      wcshdo_util(relax, "SPECSYS", "SPEC", 0, 0x0, 0, 0, 0, alt,
         colnum, colax, keyvalue, "Reference frame of spectral coordinates",
         nkeyrec, header, &status);
   }

   /* Reference frame of spectral observation. */
   if (wcs->ssysobs[0]) {
      sprintf(keyvalue, "'%s'", wcs->ssysobs);
      wcshdo_util(relax, "SSYSOBS", "SOBS", 0, 0x0, 0, 0, 0, alt,
         colnum, colax, keyvalue, "Reference frame of spectral observation",
         nkeyrec, header, &status);
   }

   /* Observer's velocity towards source. */
   if (!undefined(wcs->velosys)) {
      sprintf(keyvalue, "%20.12g", wcs->velosys);
      wcshdo_util(relax, "VELOSYS", "VSYS", 0, 0x0, 0, 0, 0, alt,
         colnum, colax, keyvalue, "[m/s] Velocity towards source",
         nkeyrec, header, &status);
   }

   /* Reference frame of source redshift. */
   if (wcs->ssyssrc[0]) {
      sprintf(keyvalue, "'%s'", wcs->ssyssrc);
      wcshdo_util(relax, "SSYSSRC", "SSRC", 0, 0x0, 0, 0, 0, alt,
         colnum, colax, keyvalue, "Reference frame of source redshift",
         nkeyrec, header, &status);
   }

   /* Redshift of the source. */
   if (!undefined(wcs->zsource)) {
      sprintf(keyvalue, "%20.12g", wcs->zsource);
      wcshdo_util(relax, "ZSOURCE", "ZSOU", 0, 0x0, 0, 0, 0, alt,
         colnum, colax, keyvalue, "Redshift of the source",
         nkeyrec, header, &status);
   }

   /* Observatory coordinates. */
   for (k = 0; k < 3; k++) {
      if (undefined(wcs->obsgeo[k])) continue;

      sprintf(keyvalue, "%20.12g", wcs->obsgeo[k]);
      sprintf(comment, "[m] ITRF observatory %c-coordinate", xyz[k]);
      obsgeo[7] = xyz[k];
      obsg[4]   = xyz[k];
      wcshdo_util(relax, obsgeo, obsg, 0, 0x0, 0, 0, 0, ' ',
         colnum, colax, keyvalue, comment, nkeyrec, header, &status);
   }

   /* MJD of observation. */
   if (!undefined(wcs->mjdobs)) {
      sprintf(keyvalue, "%20.12g", wcs->mjdobs);

      strcpy(comment, "[d] MJD of observation");
      if (wcs->dateobs[0]) {
         if (primage || (relax & 1) == 0) {
            sprintf(comment+22, " matching DATE-OBS");
         } else {
            sprintf(comment+22, " matching DOBS%d", col0);
         }
      }

      wcshdo_util(relax, "MJD-OBS", "MJDOB", 0, 0x0, 0, 0, 0, ' ',
         colnum, colax, keyvalue, comment, nkeyrec, header, &status);
   }

   /* MJD mid-observation time. */
   if (!undefined(wcs->mjdavg)) {
      sprintf(keyvalue, "%20.12g", wcs->mjdavg);

      strcpy(comment, "[d] MJD mid-observation");
      if (wcs->dateavg[0]) {
         if (primage) {
            sprintf(comment+23, " matching DATE-AVG");
         } else {
            sprintf(comment+23, " matching DAVG%d", col0);
         }
      }

      wcshdo_util(relax, "MJD-AVG", "MJDA", 0, 0x0, 0, 0, 0, ' ',
         colnum, colax, keyvalue, comment, nkeyrec, header, &status);
   }

   /* ISO-8601 date corresponding to MJD-OBS. */
   if (wcs->dateobs[0]) {
      sprintf(keyvalue, "'%s'", wcs->dateobs);

      strcpy(comment, "ISO-8601 observation date");
      if (!undefined(wcs->mjdobs)) {
         if (primage) {
            sprintf(comment+25, " matching MJD-OBS");
         } else {
            sprintf(comment+25, " matching MJDOB%d", col0);
         }
      }

      if (relax & 1) {
         /* Allow DOBSn. */
         wcshdo_util(relax, "DATE-OBS", "DOBS", WCSHDO_DOBSn, 0x0, 0, 0, 0,
            ' ', colnum, colax, keyvalue, comment, nkeyrec, header, &status);
d906 3
a908 22
         /* Force DATE-OBS. */
         wcshdo_util(relax, "DATE-OBS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0,
            0x0, keyvalue, comment, nkeyrec, header, &status);
      }
   }

   /* ISO-8601 date corresponding to MJD-OBS. */
   if (wcs->dateavg[0]) {
      sprintf(keyvalue, "'%s'", wcs->dateavg);

      strcpy(comment, "ISO-8601 mid-observation date");
      if (!undefined(wcs->mjdavg)) {
         if (primage) {
            sprintf(comment+29, " matching MJD-AVG");
         } else {
            sprintf(comment+29, " matching MJDA%d", col0);
         }
      }

      wcshdo_util(relax, "DATE-AVG", "DAVG", 0, 0x0, 0, 0, 0, ' ',
         colnum, colax, keyvalue, comment, nkeyrec, header, &status);
   }
d910 5
a914 1
   return status;
d920 16
a935 16
   int relax,
   const char pikey[],
   const char tbkey[],
   int level,
   const char tlkey[],
   int i,
   int j,
   int m,
   char alt,
   int  btcol,
   int  plcol[],
   char keyvalue[],
   const char keycomment[],
   int  *nkeyrec,
   char **header,
   int  *status)
d938 2
a939 2
   char ch0, ch1, *hptr, keyword[16], *kptr;
   int  nbyte, nc = 47, nv;
d941 1
a941 1
   if (*status) return;
d943 20
a962 6
   /* Reallocate memory in blocks of 2880 bytes. */
   if ((*nkeyrec)%32 == 0) {
      nbyte = ((*nkeyrec)/32 + 1) * 2880;
      if (!(hptr = realloc(*header, nbyte))) {
         *status = 2;
         return;
d964 7
d972 2
a973 7
      *header = hptr;
   }

   /* Construct the keyword. */
   if (alt == ' ') alt = '\0';
   if (btcol) {
      /* Binary table image array. */
d975 5
a979 5
         if (j > 0) {
            sprintf(keyword, "%d%d%s%d%c", i, j, tbkey, btcol, alt);
         } else {
            sprintf(keyword, "%d%s%d_%d%c", i, tbkey, btcol, m, alt);
         }
d981 1
a981 1
         sprintf(keyword, "%d%s%d%c", i, tbkey, btcol, alt);
d983 1
a983 1
         sprintf(keyword, "%d%s%d%c", j, tbkey, btcol, alt);
d985 1
a985 1
         sprintf(keyword, "%s%d%c", tbkey, btcol, alt);
d987 1
d989 7
a995 15
      if ((strlen(keyword) < 8) && tlkey && (relax & level)) {
         /* Use the long form. */
         if (i > 0 && j) {
            if (j > 0) {
               sprintf(keyword, "%d%d%s%d%c", i, j, tlkey, btcol, alt);
            } else {
               sprintf(keyword, "%d%s%d_%d%c", i, tlkey, btcol, m, alt);
            }
         } else if (i > 0) {
            sprintf(keyword, "%d%s%d%c", i, tlkey, btcol, alt);
         } else if (j > 0) {
            sprintf(keyword, "%d%s%d%c", j, tlkey, btcol, alt);
         } else {
            sprintf(keyword, "%s%d%c", tlkey, btcol, alt);
         }
d997 7
d1005 2
a1006 2
   } else if (plcol && plcol[0]) {
      /* Pixel list. */
d1008 5
a1012 5
         if (j > 0) {
            sprintf(keyword, "T%s%d_%d%c", tbkey, plcol[i-1], plcol[j-1], alt);
         } else {
            sprintf(keyword, "T%s%d_%d%c", tbkey, plcol[i-1], m, alt);
         }
d1014 1
a1014 1
         sprintf(keyword, "T%s%d%c", tbkey, plcol[i-1], alt);
d1016 1
a1016 1
         sprintf(keyword, "T%s%d%c", tbkey, plcol[j-1], alt);
d1018 1
a1018 19
         sprintf(keyword, "%s%d%c", tbkey, plcol[0], alt);
      }

      if ((strlen(keyword) < 8) && tlkey && (relax & level)) {
         /* Use the long form. */
         if (i > 0 && j) {
            if (j > 0) {
               sprintf(keyword, "T%s%d_%d%c", tlkey, plcol[i-1], plcol[j-1],
                  alt);
            } else {
               sprintf(keyword, "T%s%d_%d%c", tlkey, plcol[i-1], m, alt);
            }
         } else if (i > 0) {
            sprintf(keyword, "T%s%d%c", tlkey, plcol[i-1], alt);
         } else if (j > 0) {
            sprintf(keyword, "T%s%d%c", tlkey, plcol[j-1], alt);
         } else {
            sprintf(keyword, "%s%d%c", tlkey, plcol[0], alt);
         }
d1020 5
a1024 11
   } else {
      if (i > 0 && j) {
         if (j > 0) {
            sprintf(keyword, "%s%d_%d%c", pikey, i, j, alt);
         } else {
            sprintf(keyword, "%s%d_%d%c", pikey, i, m, alt);
         }
      } else if (i > 0) {
         sprintf(keyword, "%s%d%c", pikey, i, alt);
      } else if (j > 0) {
         sprintf(keyword, "%s%d%c", pikey, j, alt);
d1026 1
a1026 1
         sprintf(keyword, "%s%c", pikey, alt);
d1028 35
a1062 28
   }

   /* Double-up single-quotes in the keyvalue. */
   hptr = keyvalue + 1;
   while (*hptr) {
      if (*hptr == '\'') {
         kptr = hptr++;
         if (*hptr) {
            ch0 = *kptr;
            while (*kptr) {
               ch1 = *(++kptr);
               *kptr = ch0;
               ch0 = ch1;
            }
         }
      }

      hptr++;
   }

   if ((nv = strlen(keyvalue) > 20)) {
      /* Rob the keycomment to make space for the keyvalue. */
      nc -= (nv - 20);
   }

   hptr = *header + (80 * ((*nkeyrec)++));
   sprintf(hptr, "%-8.8s= %-20s / %-*.*s", keyword, keyvalue, nc, nc,
      keycomment);
@


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: wcshdr.c,v 4.3 2007/12/27 05:41:36 cal103 Exp cal103 $
@


4.3.1.2
log
@Error message for "Fatal error returned by Flex parser".
@
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: wcshdr.c,v 4.3.1.1 2007/12/27 13:23:47 cal103 Exp cal103 $
d52 1
a52 2
   "Invalid tabular parameters",
   "Fatal error returned by Flex parser"};
@


4.3.1.3
log
@Changed indentation.
@
text
@d31 1
a31 1
  $Id: wcshdr.c,v 4.3.1.2 2009/07/22 02:22:17 cal103 Exp cal103 $
d49 5
a53 5
  "Success",
  "Null wcsprm pointer passed",
  "Memory allocation failed",
  "Invalid tabular parameters",
  "Fatal error returned by Flex parser"};
d56 2
a57 2
  int, int, char, int, int [], char [], const char [], int *, char **,
  int *);
d64 51
a114 123
  char (*PSi_0a)[72] = 0x0, (*PSi_1a)[72] = 0x0, (*PSi_2a)[72] = 0x0;
  int  *PVi_1a = 0x0, *PVi_2a = 0x0, *PVi_3a = 0x0, *tabax, *tabidx = 0x0;
  int   getcrd, i, ip, itab, itabax, j, jtabax, m, naxis, ntabax, status;
  struct wtbarr *wtbp;
  struct tabprm *tabp;


  /* Free memory previously allocated by wcstab(). */
  if (wcs == 0x0) return 1;

  if (wcs->flag != -1 && wcs->m_flag == WCSSET) {
    if (wcs->wtb == wcs->m_wtb) wcs->wtb = 0x0;
    if (wcs->tab == wcs->m_tab) wcs->tab = 0x0;

    if (wcs->m_wtb) free(wcs->m_wtb);
    if (wcs->m_tab) {
      for (j = 0; j < wcs->ntab; j++) {
        tabfree(wcs->m_tab + j);
      }

      free(wcs->m_tab);
    }
  }

  wcs->ntab = 0;
  wcs->nwtb = 0;
  wcs->wtb  = 0x0;
  wcs->tab  = 0x0;


  /* Determine the number of -TAB axes. */
  naxis = wcs->naxis;
  if (!(tabax = calloc(naxis, sizeof(int)))) {
    return 2;
  }

  ntabax = 0;
  for (i = 0; i < naxis; i++) {
    /* Null fill. */
    wcsutil_null_fill(72, wcs->ctype[i]);

    if (!strcmp(wcs->ctype[i]+4, "-TAB")) {
      tabax[i] = ntabax++;
    } else {
      tabax[i] = -1;
    }
  }

  if (ntabax == 0) {
    /* No lookup tables. */
    status = 0;
    goto cleanup;
  }


  /* Collect information from the PSi_ma and PVi_ma keyvalues. */
  if (!((PSi_0a = calloc(ntabax, sizeof(char[72]))) &&
        (PVi_1a = calloc(ntabax, sizeof(int)))      &&
        (PVi_2a = calloc(ntabax, sizeof(int)))      &&
        (PSi_1a = calloc(ntabax, sizeof(char[72]))) &&
        (PSi_2a = calloc(ntabax, sizeof(char[72]))) &&
        (PVi_3a = calloc(ntabax, sizeof(int)))      &&
        (tabidx = calloc(ntabax, sizeof(int))))) {
    status = 2;
    goto cleanup;
  }

  for (itabax = 0; itabax < ntabax; itabax++) {
    /* Remember that calloc() zeroes allocated memory. */
    PVi_1a[itabax] = 1;
    PVi_2a[itabax] = 1;
    PVi_3a[itabax] = 1;
  }

  for (ip = 0; ip < wcs->nps; ip++) {
    itabax = tabax[wcs->ps[ip].i - 1];
    if (itabax >= 0) {
      switch (wcs->ps[ip].m) {
      case 0:
        /* EXTNAME. */
        strcpy(PSi_0a[itabax], wcs->ps[ip].value);
        wcsutil_null_fill(72, PSi_0a[itabax]);
        break;
      case 1:
        /* TTYPEn for coordinate array. */
        strcpy(PSi_1a[itabax], wcs->ps[ip].value);
        wcsutil_null_fill(72, PSi_1a[itabax]);
        break;
      case 2:
        /* TTYPEn for index vector. */
        strcpy(PSi_2a[itabax], wcs->ps[ip].value);
        wcsutil_null_fill(72, PSi_2a[itabax]);
        break;
      }
    }
  }

  for (ip = 0; ip < wcs->npv; ip++) {
    itabax = tabax[wcs->pv[ip].i - 1];
    if (itabax >= 0) {
      switch (wcs->pv[ip].m) {
      case 1:
        /* EXTVER. */
        PVi_1a[itabax] = (int)(wcs->pv[ip].value + 0.5);
        break;
      case 2:
        /* EXTLEVEL. */
        PVi_2a[itabax] = (int)(wcs->pv[ip].value + 0.5);
        break;
      case 3:
        /* Table axis number. */
        PVi_3a[itabax] = (int)(wcs->pv[ip].value + 0.5);
        break;
      }
    }
  }


  /* Determine the number of independent tables. */
  for (itabax = 0; itabax < ntabax; itabax++) {
    /* These have no defaults. */
    if (!PSi_0a[itabax][0] || !PSi_1a[itabax][0]) {
      status = 3;
d116 1
a116 1
    }
a117 34
    tabidx[itabax] = -1;
    for (jtabax = 0; jtabax < i; jtabax++) {
      /* EXTNAME, EXTVER, EXTLEVEL, and TTYPEn for the coordinate array */
      /* must match for each axis of a multi-dimensional lookup table.  */
      if (strcmp(PSi_0a[itabax], PSi_0a[jtabax]) == 0 &&
          strcmp(PSi_1a[itabax], PSi_1a[jtabax]) == 0 &&
          PVi_1a[itabax] == PVi_1a[jtabax] &&
          PVi_2a[itabax] == PVi_2a[jtabax]) {
        tabidx[itabax] = tabidx[jtabax];
        break;
      }
    }

    if (jtabax == itabax) {
      tabidx[itabax] = wcs->ntab;
      wcs->ntab++;
    }
  }

  if (!(wcs->tab = calloc(wcs->ntab, sizeof(struct tabprm)))) {
    status = 2;
    goto cleanup;
  }
  wcs->m_tab = wcs->tab;

  /* Table dimensionality; find the largest axis number. */
  for (itabax = 0; itabax < ntabax; itabax++) {
    tabp = wcs->tab + tabidx[itabax];

    /* PVi_3a records the 1-relative table axis number. */
    if (PVi_3a[itabax] > tabp->M) {
      tabp->M = PVi_3a[itabax];
    }
  }
d119 9
a127 2
  for (itab = 0; itab < wcs->ntab; itab++) {
    if ((status = tabini(1, wcs->tab[itab].M, 0, wcs->tab + itab))) {
d129 1
a129 2
    }
  }
d131 77
d209 5
a213 67
  /* Copy parameters into the tabprm structs. */
  for (i = 0; i < naxis; i++) {
    if ((itabax = tabax[i]) < 0) {
      /* Not a -TAB axis. */
      continue;
    }

    /* PVi_3a records the 1-relative table axis number. */
    m = PVi_3a[itabax] - 1;

    tabp = wcs->tab + tabidx[itabax];
    tabp->map[m] = i;
    tabp->crval[m] = wcs->crval[i];
  }

  /* Check for completeness. */
  for (itab = 0; itab < wcs->ntab; itab++) {
    for (m = 0; m < wcs->tab[itab].M; m++) {
      if (wcs->tab[itab].map[m] < 0) {
        status = 3;
        goto cleanup;
      }
    }
  }


  /* Set up for reading the arrays; how many arrays are there? */
  for (itabax = 0; itabax < ntabax; itabax++) {
    /* Does this -TAB axis have a non-degenerate index array? */
    if (PSi_2a[itabax][0]) {
      wcs->nwtb++;
    }
  }

  /* Add one coordinate array for each table. */
  wcs->nwtb += wcs->ntab;

  /* Allocate memory for structs to be returned. */
  if (!(wcs->wtb = calloc(wcs->nwtb, sizeof(struct wtbarr)))) {
    wcs->nwtb = 0;

    status = 2;
    goto cleanup;
  }
  wcs->m_wtb = wcs->wtb;

  /* Set pointers for the index and coordinate arrays. */
  wtbp = wcs->wtb;
  for (itab = 0; itab < wcs->ntab; itab++) {
    getcrd = 1;
    for (itabax = 0; itabax < ntabax; itabax++) {
      if (tabidx[itabax] != itab) continue;

      if (getcrd) {
        /* Coordinate array. */
        wtbp->i = itabax + 1;
        wtbp->m = PVi_3a[itabax];
        wtbp->kind = 'c';

        strcpy(wtbp->extnam, PSi_0a[itabax]);
        wtbp->extver = PVi_1a[itabax];
        wtbp->extlev = PVi_2a[itabax];
        strcpy(wtbp->ttype, PSi_1a[itabax]);
        wtbp->row    = 1L;
        wtbp->ndim   = wcs->tab[itab].M + 1;
        wtbp->dimlen = wcs->tab[itab].K;
        wtbp->arrayp = &(wcs->tab[itab].coord);
d215 3
a217 2
        /* Signal for tabset() to take this memory. */
        wcs->tab[itab].m_coord = (double *)0x1;
d219 3
a221 2
        wtbp++;
        getcrd = 0;
d223 1
d225 36
d262 10
a271 17
        /* Index array. */
        wtbp->i = itabax + 1;
        wtbp->m = PVi_3a[itabax];
        wtbp->kind = 'i';

        m = wtbp->m - 1;
        strcpy(wtbp->extnam, PSi_0a[itabax]);
        wtbp->extver = PVi_1a[itabax];
        wtbp->extlev = PVi_2a[itabax];
        strcpy(wtbp->ttype, PSi_2a[itabax]);
        wtbp->row    = 1L;
        wtbp->ndim   = 1;
        wtbp->dimlen = wcs->tab[itab].K + m;
        wtbp->arrayp = wcs->tab[itab].index + m;

        /* Signal for tabset() to take this memory. */
        wcs->tab[itab].m_indxs[m] = (double *)0x1;
d273 55
a327 1
        wtbp++;
d329 1
a329 2
    }
  }
d331 1
a331 1
  status = 0;
d334 13
a346 13
  if (tabax)  free(tabax);
  if (tabidx) free(tabidx);
  if (PSi_0a) free(PSi_0a);
  if (PVi_1a) free(PVi_1a);
  if (PVi_2a) free(PVi_2a);
  if (PSi_1a) free(PSi_1a);
  if (PSi_2a) free(PSi_2a);
  if (PVi_3a) free(PVi_3a);

  if (status) {
    if (wcs->tab) free(wcs->tab);
    if (wcs->wtb) free(wcs->wtb);
  }
d348 1
a348 1
  return status;
d356 2
a357 2
  int a, iwcs;
  struct wcsprm *wcsp;
d359 11
a369 17
  for (a = 0; a < 27; a++) {
    alts[a] = -1;
  }

  if (wcs == 0x0) {
    return 1;
  }

  wcsp = *wcs;
  for (iwcs = 0; iwcs < nwcs; iwcs++, wcsp++) {
    if (wcsp->colnum || wcsp->colax[0]) continue;

    if (wcsp->alt[0] == ' ') {
      a = 0;
    } else {
      a = wcsp->alt[0] - 'A' + 1;
    }
d371 8
a378 2
    alts[a] = iwcs;
  }
d380 1
a380 1
  return 0;
d388 23
a410 23
  short  *ip;
  int    a, i, icol, iwcs;
  struct wcsprm *wcsp;

  for (ip = alts[0]; ip < alts[0] + 28*1000; ip++) {
    *ip = -1;
  }

  for (icol = 0; icol < 1000; icol++) {
    alts[icol][27] = 0;
  }

  if (wcs == 0x0) {
    return 1;
  }

  wcsp = *wcs;
  for (iwcs = 0; iwcs < nwcs; iwcs++, wcsp++) {
    if (wcsp->alt[0] == ' ') {
      a = 0;
    } else {
      a = wcsp->alt[0] - 'A' + 1;
    }
d412 11
a422 11
    if (type) {
      /* Pixel list. */
      if (wcsp->colax[0]) {
        for (i = 0; i < wcsp->naxis; i++) {
          alts[wcsp->colax[i]][a]  = iwcs;
          alts[wcsp->colax[i]][27]++;
        }
      } else if (!wcsp->colnum) {
        alts[0][a]  = iwcs;
        alts[0][27]++;
      }
d424 9
a432 8
    } else {
      /* Binary table image array. */
      if (wcsp->colnum) {
        alts[wcsp->colnum][a] = iwcs;
        alts[wcsp->colnum][27]++;
      } else if (!wcsp->colax[0]) {
        alts[0][a]  = iwcs;
        alts[0][27]++;
d434 1
a434 2
    }
  }
d436 1
a436 1
  return 0;
d444 2
a445 2
  int a, status = 0;
  struct wcsprm *wcsp;
d447 3
a449 3
  if (wcs == 0x0) {
    return 1;
  }
d451 4
a454 4
  wcsp = *wcs;
  for (a = 0; a < *nwcs; a++, wcsp++) {
    status |= wcsfree(wcsp);
  }
d456 1
a456 1
  free(*wcs);
d458 2
a459 2
  *nwcs = 0;
  *wcs = 0x0;
d461 1
a461 1
  return status;
d471 78
a548 278
  char alt, comment[72], keyvalue[72], keyword[16], obsg[8] = "OBSG?",
       obsgeo[8] = "OBSGEO-?", ptype, xtype, xyz[] = "XYZ";
  int  bintab, col0, *colax, colnum, i, j, k, naxis, pixlist, primage,
       status = 0;

  *nkeyrec = 0;
  *header  = 0x0;

  if (wcs == 0x0) {
    return 1;
  }

  if (wcs->flag != WCSSET) {
    if ((status = wcsset(wcs))) return status;
  }

  if ((naxis = wcs->naxis) == 0) {
    return 0;
  }


  /* These are mainly for convenience. */
  alt = wcs->alt[0];
  if (alt == ' ') alt = '\0';
  colnum = wcs->colnum;
  colax  = wcs->colax;

  primage = 0;
  bintab  = 0;
  pixlist = 0;
  if (colnum) {
    bintab  = 1;
    col0 = colnum;
  } else if (colax[0]) {
    pixlist = 1;
    col0 = colax[0];
  } else {
    primage = 1;
  }


  /* WCS dimension. */
  if (!pixlist) {
    sprintf(keyvalue, "%20d", naxis);
    wcshdo_util(relax, "WCSAXES", "WCAX", 0, 0x0, 0, 0, 0, alt, colnum, colax,
      keyvalue, "Number of coordinate axes", nkeyrec, header, &status);
  }

  /* Reference pixel coordinates. */
  for (j = 0; j < naxis; j++) {
    sprintf(keyvalue, "%20.12g", wcs->crpix[j]);
    wcshdo_util(relax, "CRPIX", "CRP", WCSHDO_CRPXna, "CRPX", 0, j+1, 0, alt,
      colnum, colax, keyvalue, "Pixel coordinate of reference point",
      nkeyrec, header, &status);
  }

  /* Linear transformation matrix. */
  k = 0;
  for (i = 0; i < naxis; i++) {
    for (j = 0; j < naxis; j++, k++) {
      if (i == j) {
        if (wcs->pc[k] == 1.0) continue;
      } else {
        if (wcs->pc[k] == 0.0) continue;
      }

      sprintf(keyvalue, "%20.12g", wcs->pc[k]);
      wcshdo_util(relax, "PC", bintab ? "PC" : "P", WCSHDO_TPCn_ka,
        bintab ? 0x0 : "PC", i+1, j+1, 0, alt, colnum, colax, keyvalue,
        "Coordinate transformation matrix element",
        nkeyrec, header, &status);
    }
  }

  /* Coordinate increment at reference point. */
  for (i = 0; i < naxis; i++) {
    sprintf(keyvalue, "%20.12g", wcs->cdelt[i]);
    comment[0] = '\0';
    if (wcs->cunit[i][0]) sprintf(comment, "[%s] ", wcs->cunit[i]);
    strcat(comment, "Coordinate increment at reference point");
    wcshdo_util(relax, "CDELT", "CDE", WCSHDO_CRPXna, "CDLT", i+1, 0, 0, alt,
      colnum, colax, keyvalue, comment, nkeyrec, header, &status);
  }

  /* Units of coordinate increment and reference value. */
  for (i = 0; i < naxis; i++) {
    if (wcs->cunit[i][0] == '\0') continue;

    sprintf(keyvalue, "'%s'", wcs->cunit[i]);
    wcshdo_util(relax, "CUNIT", "CUN", WCSHDO_CRPXna, "CUNI", i+1, 0, 0, alt,
      colnum, colax, keyvalue, "Units of coordinate increment and value",
      nkeyrec, header, &status);
  }

  /* Coordinate type. */
  for (i = 0; i < naxis; i++) {
    if (wcs->ctype[i][0] == '\0') continue;

    sprintf(keyvalue, "'%s'", wcs->ctype[i]);
    strcpy(comment, "Coordinate type code");
    if (i == wcs->lng || i == wcs->lat) {
      if (strncmp(wcs->ctype[i], "RA--", 4) == 0) {
        strcpy(comment, "Right ascension, ");
      } else if (strncmp(wcs->ctype[i], "DEC-", 4) == 0) {
        strcpy(comment, "Declination, ");
      } else if (strncmp(wcs->ctype[i]+1, "LON", 3) == 0 ||
                 strncmp(wcs->ctype[i]+1, "LAT", 3) == 0) {
        switch (wcs->ctype[i][0]) {
        case 'G':
          strcpy(comment, "galactic ");
          break;
        case 'E':
          strcpy(comment, "ecliptic ");
        case 'H':
          strcpy(comment, "helioecliptic ");
        case 'S':
          strcpy(comment, "supergalactic ");
        }

        if (i == wcs->lng) {
          strcat(comment, "longitude, ");
        } else {
          strcat(comment, "latitude, ");
        }

        wcs->ctype[i][0] = toupper(wcs->ctype[i][0]);
      }

      strcat(comment, wcs->cel.prj.name);
      strcat(comment, " projection");

    } else if (i == wcs->spec) {
      spctyp(wcs->ctype[i], 0x0, 0x0, comment, 0x0, &ptype, &xtype, 0x0);
      if (ptype == xtype) {
        strcat(comment, " (linear)");
      } else {
        switch (xtype) {
        case 'F':
          strcat(comment, " (linear in frequency)");
          break;
        case 'V':
          strcat(comment, " (linear in velocity)");
          break;
        case 'W':
          strcat(comment, " (linear in wavelength)");
          break;
        }
      }
    }

    wcshdo_util(relax, "CTYPE", "CTY", WCSHDO_CRPXna, "CTYP", i+1, 0, 0, alt,
      colnum, colax, keyvalue, comment, nkeyrec, header, &status);
  }

  /* Coordinate value at reference point. */
  for (i = 0; i < naxis; i++) {
    sprintf(keyvalue, "%20.12g", wcs->crval[i]);
    comment[0] = '\0';
    if (wcs->cunit[i][0]) sprintf(comment, "[%s] ", wcs->cunit[i]);
    strcat(comment, "Coordinate value at reference point");
    wcshdo_util(relax, "CRVAL", "CRV", WCSHDO_CRPXna, "CRVL", i+1, 0, 0, alt,
      colnum, colax, keyvalue, comment, nkeyrec, header, &status);
  }

  /* Parameter values. */
  for (k = 0; k < wcs->npv; k++) {
    sprintf(keyvalue, "%20.12g", (wcs->pv[k]).value);
    if ((wcs->pv[k]).i == (wcs->lng + 1)) {
      switch ((wcs->pv[k]).m) {
      case 1:
        strcpy(comment, "[deg] Native longitude of the reference point");
        break;
      case 2:
        strcpy(comment, "[deg] Native latitude  of the reference point");
        break;
      case 3:
        if (primage) {
          sprintf(keyword, "LONPOLE%c", alt);
        } else if (bintab) {
          sprintf(keyword, "LONP%d%c", colnum, alt);
        } else {
          sprintf(keyword, "LONP%d%c", colax[(wcs->pv[k]).i - 1], alt);
        }
        sprintf(comment, "[deg] alias for %s (has precedence)", keyword);
        break;
      case 4:
        if (primage) {
          sprintf(keyword, "LATPOLE%c", alt);
        } else if (bintab) {
          sprintf(keyword, "LATP%d%c", colnum, alt);
        } else {
          sprintf(keyword, "LATP%d%c", colax[(wcs->pv[k]).i - 1], alt);
        }
        sprintf(comment, "[deg] alias for %s (has precedence)", keyword);
        break;
      }
    } else if ((wcs->pv[k]).i == (wcs->lat + 1)) {
      sprintf(comment, "%s projection parameter", wcs->cel.prj.code);
    } else {
      strcpy(comment, "Coordinate transformation parameter");
    }

    wcshdo_util(relax, "PV", "V", WCSHDO_PVn_ma, "PV", wcs->pv[k].i, -1,
      wcs->pv[k].m, alt, colnum, colax, keyvalue, comment,
      nkeyrec, header, &status);
  }

  for (k = 0; k < wcs->nps; k++) {
    sprintf(keyvalue, "'%s'", (wcs->ps[k]).value);

    wcshdo_util(relax, "PS", "S", WCSHDO_PVn_ma, "PS", wcs->ps[k].i, -1,
      wcs->ps[k].m, alt, colnum, colax, keyvalue,
      "Coordinate transformation parameter",
      nkeyrec, header, &status);
  }

  /* Celestial and spectral transformation parameters. */
  if (!undefined(wcs->lonpole)) {
    sprintf(keyvalue, "%20.12g", wcs->lonpole);
    wcshdo_util(relax, "LONPOLE", "LONP", 0, 0x0, 0, 0, 0, alt,
      colnum, colax, keyvalue, "[deg] Native longitude of celestial pole",
      nkeyrec, header, &status);
  }

  if (!undefined(wcs->latpole)) {
    sprintf(keyvalue, "%20.12g", wcs->latpole);
    wcshdo_util(relax, "LATPOLE", "LATP", 0, 0x0, 0, 0, 0, alt,
      colnum, colax, keyvalue, "[deg] Native latitude of celestial pole",
      nkeyrec, header, &status);
  }

  if (!undefined(wcs->restfrq)) {
    sprintf(keyvalue, "%20.12g", wcs->restfrq);
    wcshdo_util(relax, "RESTFRQ", "RFRQ", 0, 0x0, 0, 0, 0, alt,
      colnum, colax, keyvalue, "[Hz] Line rest frequency",
      nkeyrec, header, &status);
  }

  if (!undefined(wcs->restwav)) {
    sprintf(keyvalue, "%20.12g", wcs->restwav);
    wcshdo_util(relax, "RESTWAV", "RWAV", 0, 0x0, 0, 0, 0, alt,
      colnum, colax, keyvalue, "[Hz] Line rest wavelength",
      nkeyrec, header, &status);
  }

  /* Coordinate system title. */
  if (wcs->wcsname[0]) {
    sprintf(keyvalue, "'%s'", wcs->wcsname);
    if (bintab) {
      wcshdo_util(relax, "WCSNAME", "WCSN", 0, 0x0, 0, 0, 0, alt,
        colnum, colax, keyvalue, "Coordinate system title",
        nkeyrec, header, &status);
    } else {
      /* TWCS was a mistake. */
      wcshdo_util(relax, "WCSNAME", "TWCS", WCSHDO_WCSNna, "WCSN", 0, 0, 0,
        alt, colnum, colax, keyvalue, "Coordinate system title",
        nkeyrec, header, &status);
    }
  }

  /* Coordinate axis title. */
  if (wcs->cname) {
    for (i = 0; i < naxis; i++) {
      if (wcs->cname[i][0] == '\0') continue;

      sprintf(keyvalue, "'%s'", wcs->cname[i]);
      wcshdo_util(relax, "CNAME", "CNA", WCSHDO_CNAMna, "CNAM", i+1, 0, 0,
        alt, colnum, colax, keyvalue, "Axis name for labelling purposes",
        nkeyrec, header, &status);
    }
  }

  /* Random error in coordinate. */
  if (wcs->crder) {
    for (i = 0; i < naxis; i++) {
      if (undefined(wcs->crder[i])) continue;

      sprintf(keyvalue, "%20.12g", wcs->crder[i]);
d551 78
a628 12
      strcat(comment, "Random error in coordinate");
      wcshdo_util(relax, "CRDER", "CRD", WCSHDO_CNAMna, "CRDE", i+1, 0, 0,
        alt, colnum, colax, keyvalue, comment, nkeyrec, header, &status);
    }
  }

  /* Systematic error in coordinate. */
  if (wcs->csyer) {
    for (i = 0; i < naxis; i++) {
      if (undefined(wcs->csyer[i])) continue;

      sprintf(keyvalue, "%20.12g", wcs->csyer[i]);
d631 39
a669 99
      strcat(comment, "Systematic error in coordinate");
      wcshdo_util(relax, "CSYER", "CSY", WCSHDO_CNAMna, "CSYE", i+1, 0, 0,
        alt, colnum, colax, keyvalue, comment, nkeyrec, header, &status);
    }
  }

  /* Equatorial coordinate system type. */
  if (wcs->radesys[0]) {
    sprintf(keyvalue, "'%s'", wcs->radesys);
    wcshdo_util(relax, "RADESYS", "RADE", 0, 0x0, 0, 0, 0, alt,
      colnum, colax, keyvalue, "Equatorial coordinate system",
      nkeyrec, header, &status);
  }

  /* Equinox of equatorial coordinate system. */
  if (!undefined(wcs->equinox)) {
    sprintf(keyvalue, "%20.12g", wcs->equinox);
    wcshdo_util(relax, "EQUINOX", "EQUI", 0, 0x0, 0, 0, 0, alt,
      colnum, colax, keyvalue, "[yr] Equinox of equatorial coordinates",
      nkeyrec, header, &status);
  }

  /* Reference frame of spectral coordinates. */
  if (wcs->specsys[0]) {
    sprintf(keyvalue, "'%s'", wcs->specsys);
    wcshdo_util(relax, "SPECSYS", "SPEC", 0, 0x0, 0, 0, 0, alt,
      colnum, colax, keyvalue, "Reference frame of spectral coordinates",
      nkeyrec, header, &status);
  }

  /* Reference frame of spectral observation. */
  if (wcs->ssysobs[0]) {
    sprintf(keyvalue, "'%s'", wcs->ssysobs);
    wcshdo_util(relax, "SSYSOBS", "SOBS", 0, 0x0, 0, 0, 0, alt,
      colnum, colax, keyvalue, "Reference frame of spectral observation",
      nkeyrec, header, &status);
  }

  /* Observer's velocity towards source. */
  if (!undefined(wcs->velosys)) {
    sprintf(keyvalue, "%20.12g", wcs->velosys);
    wcshdo_util(relax, "VELOSYS", "VSYS", 0, 0x0, 0, 0, 0, alt,
      colnum, colax, keyvalue, "[m/s] Velocity towards source",
      nkeyrec, header, &status);
  }

  /* Reference frame of source redshift. */
  if (wcs->ssyssrc[0]) {
    sprintf(keyvalue, "'%s'", wcs->ssyssrc);
    wcshdo_util(relax, "SSYSSRC", "SSRC", 0, 0x0, 0, 0, 0, alt,
      colnum, colax, keyvalue, "Reference frame of source redshift",
      nkeyrec, header, &status);
  }

  /* Redshift of the source. */
  if (!undefined(wcs->zsource)) {
    sprintf(keyvalue, "%20.12g", wcs->zsource);
    wcshdo_util(relax, "ZSOURCE", "ZSOU", 0, 0x0, 0, 0, 0, alt,
      colnum, colax, keyvalue, "Redshift of the source",
      nkeyrec, header, &status);
  }

  /* Observatory coordinates. */
  for (k = 0; k < 3; k++) {
    if (undefined(wcs->obsgeo[k])) continue;

    sprintf(keyvalue, "%20.12g", wcs->obsgeo[k]);
    sprintf(comment, "[m] ITRF observatory %c-coordinate", xyz[k]);
    obsgeo[7] = xyz[k];
    obsg[4]   = xyz[k];
    wcshdo_util(relax, obsgeo, obsg, 0, 0x0, 0, 0, 0, ' ',
      colnum, colax, keyvalue, comment, nkeyrec, header, &status);
  }

  /* MJD of observation. */
  if (!undefined(wcs->mjdobs)) {
    sprintf(keyvalue, "%20.12g", wcs->mjdobs);

    strcpy(comment, "[d] MJD of observation");
    if (wcs->dateobs[0]) {
      if (primage || (relax & 1) == 0) {
        sprintf(comment+22, " matching DATE-OBS");
      } else {
        sprintf(comment+22, " matching DOBS%d", col0);
      }
    }

    wcshdo_util(relax, "MJD-OBS", "MJDOB", 0, 0x0, 0, 0, 0, ' ',
      colnum, colax, keyvalue, comment, nkeyrec, header, &status);
  }

  /* MJD mid-observation time. */
  if (!undefined(wcs->mjdavg)) {
    sprintf(keyvalue, "%20.12g", wcs->mjdavg);

    strcpy(comment, "[d] MJD mid-observation");
    if (wcs->dateavg[0]) {
      if (primage) {
        sprintf(comment+23, " matching DATE-AVG");
d671 1
a671 1
        sprintf(comment+23, " matching DAVG%d", col0);
a672 1
    }
d674 50
a723 12
    wcshdo_util(relax, "MJD-AVG", "MJDA", 0, 0x0, 0, 0, 0, ' ',
      colnum, colax, keyvalue, comment, nkeyrec, header, &status);
  }

  /* ISO-8601 date corresponding to MJD-OBS. */
  if (wcs->dateobs[0]) {
    sprintf(keyvalue, "'%s'", wcs->dateobs);

    strcpy(comment, "ISO-8601 observation date");
    if (!undefined(wcs->mjdobs)) {
      if (primage) {
        sprintf(comment+25, " matching MJD-OBS");
d725 166
a890 23
        sprintf(comment+25, " matching MJDOB%d", col0);
      }
    }

    if (relax & 1) {
      /* Allow DOBSn. */
      wcshdo_util(relax, "DATE-OBS", "DOBS", WCSHDO_DOBSn, 0x0, 0, 0, 0,
        ' ', colnum, colax, keyvalue, comment, nkeyrec, header, &status);
    } else {
      /* Force DATE-OBS. */
      wcshdo_util(relax, "DATE-OBS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0,
        0x0, keyvalue, comment, nkeyrec, header, &status);
    }
  }

  /* ISO-8601 date corresponding to MJD-OBS. */
  if (wcs->dateavg[0]) {
    sprintf(keyvalue, "'%s'", wcs->dateavg);

    strcpy(comment, "ISO-8601 mid-observation date");
    if (!undefined(wcs->mjdavg)) {
      if (primage) {
        sprintf(comment+29, " matching MJD-AVG");
d892 22
a913 3
        sprintf(comment+29, " matching MJDA%d", col0);
      }
    }
d915 1
a915 5
    wcshdo_util(relax, "DATE-AVG", "DAVG", 0, 0x0, 0, 0, 0, ' ',
      colnum, colax, keyvalue, comment, nkeyrec, header, &status);
  }

  return status;
d921 16
a936 16
  int relax,
  const char pikey[],
  const char tbkey[],
  int level,
  const char tlkey[],
  int i,
  int j,
  int m,
  char alt,
  int  btcol,
  int  plcol[],
  char keyvalue[],
  const char keycomment[],
  int  *nkeyrec,
  char **header,
  int  *status)
d939 2
a940 2
  char ch0, ch1, *hptr, keyword[16], *kptr;
  int  nbyte, nc = 47, nv;
d942 1
a942 1
  if (*status) return;
d944 6
a949 20
  /* Reallocate memory in blocks of 2880 bytes. */
  if ((*nkeyrec)%32 == 0) {
    nbyte = ((*nkeyrec)/32 + 1) * 2880;
    if (!(hptr = realloc(*header, nbyte))) {
      *status = 2;
      return;
    }

    *header = hptr;
  }

  /* Construct the keyword. */
  if (alt == ' ') alt = '\0';
  if (btcol) {
    /* Binary table image array. */
    if (i > 0 && j) {
      if (j > 0) {
        sprintf(keyword, "%d%d%s%d%c", i, j, tbkey, btcol, alt);
      } else {
        sprintf(keyword, "%d%s%d_%d%c", i, tbkey, btcol, m, alt);
a950 7
    } else if (i > 0) {
      sprintf(keyword, "%d%s%d%c", i, tbkey, btcol, alt);
    } else if (j > 0) {
      sprintf(keyword, "%d%s%d%c", j, tbkey, btcol, alt);
    } else {
      sprintf(keyword, "%s%d%c", tbkey, btcol, alt);
    }
d952 7
a958 2
    if ((strlen(keyword) < 8) && tlkey && (relax & level)) {
      /* Use the long form. */
d960 5
a964 5
        if (j > 0) {
          sprintf(keyword, "%d%d%s%d%c", i, j, tlkey, btcol, alt);
        } else {
          sprintf(keyword, "%d%s%d_%d%c", i, tlkey, btcol, m, alt);
        }
d966 1
a966 1
        sprintf(keyword, "%d%s%d%c", i, tlkey, btcol, alt);
d968 1
a968 1
        sprintf(keyword, "%d%s%d%c", j, tlkey, btcol, alt);
d970 1
a970 1
        sprintf(keyword, "%s%d%c", tlkey, btcol, alt);
a971 1
    }
d973 15
a987 7
  } else if (plcol && plcol[0]) {
    /* Pixel list. */
    if (i > 0 && j) {
      if (j > 0) {
        sprintf(keyword, "T%s%d_%d%c", tbkey, plcol[i-1], plcol[j-1], alt);
      } else {
        sprintf(keyword, "T%s%d_%d%c", tbkey, plcol[i-1], m, alt);
a988 7
    } else if (i > 0) {
      sprintf(keyword, "T%s%d%c", tbkey, plcol[i-1], alt);
    } else if (j > 0) {
      sprintf(keyword, "T%s%d%c", tbkey, plcol[j-1], alt);
    } else {
      sprintf(keyword, "%s%d%c", tbkey, plcol[0], alt);
    }
d990 2
a991 2
    if ((strlen(keyword) < 8) && tlkey && (relax & level)) {
      /* Use the long form. */
d993 5
a997 5
        if (j > 0) {
          sprintf(keyword, "T%s%d_%d%c", tlkey, plcol[i-1], plcol[j-1], alt);
        } else {
          sprintf(keyword, "T%s%d_%d%c", tlkey, plcol[i-1], m, alt);
        }
d999 1
a999 1
        sprintf(keyword, "T%s%d%c", tlkey, plcol[i-1], alt);
d1001 1
a1001 1
        sprintf(keyword, "T%s%d%c", tlkey, plcol[j-1], alt);
d1003 19
a1021 1
        sprintf(keyword, "%s%d%c", tlkey, plcol[0], alt);
d1023 11
a1033 5
    }
  } else {
    if (i > 0 && j) {
      if (j > 0) {
        sprintf(keyword, "%s%d_%d%c", pikey, i, j, alt);
d1035 1
a1035 1
        sprintf(keyword, "%s%d_%d%c", pikey, i, m, alt);
d1037 28
a1064 35
    } else if (i > 0) {
      sprintf(keyword, "%s%d%c", pikey, i, alt);
    } else if (j > 0) {
      sprintf(keyword, "%s%d%c", pikey, j, alt);
    } else {
      sprintf(keyword, "%s%c", pikey, alt);
    }
  }

  /* Double-up single-quotes in the keyvalue. */
  hptr = keyvalue + 1;
  while (*hptr) {
    if (*hptr == '\'') {
      kptr = hptr++;
      if (*hptr) {
        ch0 = *kptr;
        while (*kptr) {
          ch1 = *(++kptr);
          *kptr = ch0;
          ch0 = ch1;
        }
      }
    }

    hptr++;
  }

  if ((nv = strlen(keyvalue) > 20)) {
    /* Rob the keycomment to make space for the keyvalue. */
    nc -= (nv - 20);
  }

  hptr = *header + (80 * ((*nkeyrec)++));
  sprintf(hptr, "%-8.8s= %-20s / %-*.*s", keyword, keyvalue, nc, nc,
    keycomment);
@


4.2
log
@WCSLIB 4.2: in wcstab(), removed an extraneous assignment to wtbp->kind for
index arrays.
@
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: wcshdr.c,v 4.1 2005/08/31 03:52:31 cal103 Exp cal103 $
d34 2
d39 3
a43 2
#include "wcshdr.h"
#include "wcsutil.h"
d54 4
d118 1
a118 1
   /* Collect information from the PSi_ma and PVi_ma cards. */
d225 1
a225 1
      if (status = tabini(1, wcs->tab[itab].M, 0, wcs->tab + itab)) {
d355 1
a355 1
   int a, i;
d367 38
a404 1
   for (i = 0; i < nwcs; i++, wcsp++) {
d411 22
a432 1
      alts[a] = i;
d462 603
@


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: wcshdr.c,v 4.2 2005/09/22 08:53:12 cal103 Exp cal103 $
@


4.2.1.2
log
@Parenthesised assignments used as truth values.
@
text
@d4 1
a4 1
*   Copyright (C) 1995-2007, Mark Calabretta
d30 1
a30 1
*   $Id: wcshdr.c,v 4.2.1.1 2005/12/05 02:39:43 cal103 Exp cal103 $
d217 1
a217 1
      if ((status = tabini(1, wcs->tab[itab].M, 0, wcs->tab + itab))) {
@


4.2.1.3
log
@Initial implementation of wcshdo() - only does image headers.
@
text
@d30 1
a30 1
*   $Id: wcshdr.c,v 4.2.1.2 2007/06/29 00:58:57 cal103 Exp cal103 $
a32 2
#include <ctype.h>
#include <stdio.h>
d36 2
a37 1
#include "wcsmath.h"
a39 2
#include "tab.h"
#include "wcs.h"
a395 350

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

int wcshdo(struct wcsprm *wcs, int *ncards, char **header)

{
   char alt, comment[72], keyvalue[72], keyword[8], ptype, xtype,
        xyz[] = "XYZ";
   int  i, j, k, naxis, status;
   struct wtbarr *wtbp;

   *ncards = 0;
   *header = 0x0;

   if (wcs == 0x0) {
      return 1;
   }

   if (wcs->flag != WCSSET) {
      if ((status = wcsset(wcs))) return status;
   }

   if ((naxis = wcs->naxis) == 0) {
      return 0;
   }

   alt = wcs->alt[0];

   sprintf(keyword,  "WCSAXES%c", alt);
   sprintf(keyvalue, "%20d", naxis);
   wcsutil_hdr("Number of coordinate axes", keyword, keyvalue, ncards, header,
      &status);

   for (j = 0; j < naxis; j++) {
      sprintf(keyword,  "CRPIX%d%c", j+1, alt);
      sprintf(keyvalue, "%20.12g", wcs->crpix[j]);
      wcsutil_hdr("Pixel coordinate of reference point", keyword, keyvalue,
         ncards, header, &status);
   }

   /* Linear transformation matrix. */
   k = 0;
   for (i = 0; i < naxis; i++) {
      for (j = 0; j < naxis; j++, k++) {
         if (i == j) {
           if (wcs->pc[k] == 1.0) continue;
         } else {
           if (wcs->pc[k] == 0.0) continue;
         }
         sprintf(keyword,  "PC%d_%d%c", i+1, j+1, alt);
         sprintf(keyvalue, "%20.12g", wcs->pc[k]);
         wcsutil_hdr("Coordinate transformation matrix element", keyword,
            keyvalue, ncards, header, &status);
      }
   }

   /* Coordinate increment at reference point. */
   for (i = 0; i < naxis; i++) {
      sprintf(keyword,  "CDELT%d%c", i+1, alt);
      sprintf(keyvalue, "%20.12g", wcs->cdelt[i]);
      comment[0] = '\0';
      if (wcs->cunit[i][0]) sprintf(comment, "[%s] ", wcs->cunit[i]);
      strcat(comment, "Coordinate increment at reference point");
      wcsutil_hdr(comment, keyword, keyvalue, ncards, header, &status);
   }

   /* Coordinate value at reference point. */
   for (i = 0; i < naxis; i++) {
      sprintf(keyword,  "CRVAL%d%c", i+1, alt);
      sprintf(keyvalue, "%20.12g", wcs->crval[i]);
      comment[0] = '\0';
      if (wcs->cunit[i][0]) sprintf(comment, "[%s] ", wcs->cunit[i]);
      strcat(comment, "Coordinate value at reference point");
      wcsutil_hdr(comment, keyword, keyvalue, ncards, header, &status);
   }

   /* Units of coordinate increment and reference value. */
   for (i = 0; i < naxis; i++) {
      if (wcs->cunit[i][0] == '\0') continue;
      sprintf(keyword,  "CUNIT%d%c", i+1, alt);
      sprintf(keyvalue, "'%s'", wcs->cunit[i]);
      wcsutil_hdr("Units of coordinate increment and value",
         keyword, keyvalue, ncards, header, &status);
   }

   /* Coordinate type. */
   for (i = 0; i < naxis; i++) {
      if (wcs->ctype[i][0] == '\0') continue;
      sprintf(keyword,  "CTYPE%d%c", i+1, alt);
      sprintf(keyvalue, "'%s'", wcs->ctype[i]);
      strcpy(comment, "Coordinate type code");
      if (i == wcs->lng || i == wcs->lat) {
         if (strncmp(wcs->ctype[i], "RA--", 4) == 0) {
            strcpy(comment, "Right ascension, ");
         } else if (strncmp(wcs->ctype[i], "DEC-", 4) == 0) {
            strcpy(comment, "Declination, ");
         } else if (strncmp(wcs->ctype[i]+1, "LON", 3) == 0 ||
                    strncmp(wcs->ctype[i]+1, "LAT", 3) == 0) {
            switch (wcs->ctype[i][0]) {
            case 'G':
               strcpy(comment, "galactic ");
               break;
            case 'E':
               strcpy(comment, "ecliptic ");
            case 'H':
               strcpy(comment, "helioecliptic ");
            case 'S':
               strcpy(comment, "supergalactic ");
            }

            if (i == wcs->lng) {
               strcat(comment, "longitude, ");
            } else {
               strcat(comment, "latitude, ");
            }

            wcs->ctype[i][0] = toupper(wcs->ctype[i][0]);
         }

         strcat(comment, wcs->cel.prj.name);
         strcat(comment, " projection");

      } else if (i == wcs->spec) {
         spctyp(wcs->ctype[i], 0x0, 0x0, comment, 0x0, &ptype, &xtype, 0x0);
         if (ptype == xtype) {
            strcat(comment, " (linear)");
         } else {
            switch (xtype) {
            case 'F':
               strcat(comment, " (linear in frequency)");
               break;
            case 'V':
               strcat(comment, " (linear in velocity)");
               break;
            case 'W':
               strcat(comment, " (linear in wavelength)");
               break;
            }
         }
      }
      wcsutil_hdr(comment, keyword, keyvalue, ncards, header, &status);
   }

   /* Celestial and spectral transformation parameters. */
   if (!undefined(wcs->lonpole)) {
      sprintf(keyword,  "LONPOLE%c", alt);
      sprintf(keyvalue, "%20.12g", wcs->lonpole);
      wcsutil_hdr("[deg] Native longitude of celestial pole", keyword,
         keyvalue, ncards, header, &status);
   }

   if (!undefined(wcs->latpole)) {
      sprintf(keyword,  "LATPOLE%c", alt);
      sprintf(keyvalue, "%20.12g", wcs->latpole);
      wcsutil_hdr("[deg] Native latitude of celestial pole", keyword,
         keyvalue, ncards, header, &status);
   }

   if (!undefined(wcs->restfrq)) {
      sprintf(keyword,  "RESTFRQ%c", alt);
      sprintf(keyvalue, "%20.12g", wcs->restfrq);
      wcsutil_hdr("[Hz] Line rest frequency", keyword, keyvalue, ncards,
         header, &status);
   }

   if (!undefined(wcs->restwav)) {
      sprintf(keyword,  "RESTWAV%c", alt);
      sprintf(keyvalue, "%20.12g", wcs->restwav);
      wcsutil_hdr("[m] Line rest wavelength", keyword, keyvalue, ncards,
         header, &status);
   }

   /* Parameter values. */
   for (k = 0; k < wcs->npv; k++) {
      sprintf(keyword,  "PV%d_%d%c", (wcs->pv[k]).i, (wcs->pv[k]).m, alt);
      sprintf(keyvalue, "%20.12g", (wcs->pv[k]).value);
      if ((wcs->pv[k]).i == (wcs->lng + 1)) {
         switch ((wcs->pv[k]).m) {
         case 1:
            strcpy(comment, "[deg] Native longitude of the reference point");
            break;
         case 2:
            strcpy(comment, "[deg] Native latitude  of the reference point");
            break;
         case 3:
            sprintf(comment, "[deg] alias for LONPOLE%c (has precedence)",
                    alt);
            break;
         case 4:
            sprintf(comment, "[deg] alias for LATPOLE%c (has precedence)",
                    alt);
            break;
         }
      } else if ((wcs->pv[k]).i == (wcs->lat + 1)) {
        sprintf(comment, "%s projection parameter", wcs->cel.prj.code);
      } else {
        strcpy(comment, "Coordinate transformation parameter");
      }
      wcsutil_hdr(comment, keyword, keyvalue, ncards, header, &status);
   }

   for (k = 0; k < wcs->nps; k++) {
      sprintf(keyword,  "PS%d_%d%c", (wcs->ps[k]).i, (wcs->ps[k]).m, alt);
      sprintf(keyvalue, "'%s'", (wcs->ps[k]).value);
      wcsutil_hdr("Coordinate transformation parameter", keyword, keyvalue,
         ncards, header, &status);
   }

   if (wcs->wcsname[0]) {
      sprintf(keyword,  "WCSNAME%c", alt);
      sprintf(keyvalue, "'%s'", wcs->wcsname);
      wcsutil_hdr("Coordinate system title", keyword, keyvalue, ncards,
         header, &status);
   }

   if (wcs->cname) {
      for (i = 0; i < naxis; i++) {
         if (wcs->cname[i][0] == '\0') continue;
         sprintf(keyword,  "CNAME%d%c", i+1, alt);
         sprintf(keyvalue, "'%s'", wcs->cname[i]);
         wcsutil_hdr("Axis name for labelling purposes", keyword, keyvalue,
            ncards, header, &status);
      }
   }

   if (wcs->crder) {
      for (i = 0; i < naxis; i++) {
         if (undefined(wcs->crder[i])) continue;
         sprintf(keyword,  "CRDER%d%c", i+1, alt);
         sprintf(keyvalue, "%20.12g", wcs->crder[i]);
         comment[0] = '\0';
         if (wcs->cunit[i][0]) sprintf(comment, "[%s] ", wcs->cunit[i]);
         strcat(comment, "Random error in coordinate");
         wcsutil_hdr(comment, keyword, keyvalue, ncards, header, &status);
      }
   }

   if (wcs->csyer) {
      for (i = 0; i < naxis; i++) {
         if (undefined(wcs->csyer[i])) continue;
         sprintf(keyword,  "CSYER%d%c", i+1, alt);
         sprintf(keyvalue, "%20.12g", wcs->csyer[i]);
         comment[0] = '\0';
         if (wcs->cunit[i][0]) sprintf(comment, "[%s] ", wcs->cunit[i]);
         strcat(comment, "Systematic error in coordinate");
         wcsutil_hdr(comment, keyword, keyvalue, ncards, header, &status);
      }
   }

   if (wcs->radesys[0]) {
      sprintf(keyword,  "RADESYS%c", alt);
      sprintf(keyvalue, "'%s'", wcs->radesys);
      wcsutil_hdr("Equatorial coordinate system", keyword, keyvalue, ncards,
         header, &status);
   }

   if (!undefined(wcs->equinox)) {
      sprintf(keyword,  "EQUINOX%c", alt);
      sprintf(keyvalue, "%20.12g", wcs->equinox);
      wcsutil_hdr("[yr] Equinox of equatorial coordinates", keyword, keyvalue,
         ncards, header, &status);
   }

   if (wcs->specsys[0]) {
      sprintf(keyword,  "SPECSYS%c", alt);
      sprintf(keyvalue, "'%s'", wcs->specsys);
      wcsutil_hdr("Reference frame of spectral coordinates", keyword,
         keyvalue, ncards, header, &status);
   }

   if (wcs->ssysobs[0]) {
      sprintf(keyword,  "SSYSOBS%c", alt);
      sprintf(keyvalue, "'%s'", wcs->ssysobs);
      wcsutil_hdr("Reference frame of spectral observation", keyword,
         keyvalue, ncards, header, &status);
   }

   if (!undefined(wcs->velosys)) {
      sprintf(keyword,  "VELOSYS%c", alt);
      sprintf(keyvalue, "%20.12g", wcs->velosys);
      wcsutil_hdr("[m/s] Velocity towards source", keyword, keyvalue, ncards,
         header, &status);
   }

   if (wcs->ssyssrc[0]) {
      sprintf(keyword,  "SSYSSRC%c", alt);
      sprintf(keyvalue, "'%s'", wcs->ssyssrc);
      wcsutil_hdr("Reference frame of source redshift", keyword, keyvalue,
         ncards, header, &status);
   }

   if (!undefined(wcs->zsource)) {
      sprintf(keyword,  "ZSOURCE%c", alt);
      sprintf(keyvalue, "%20.12g", wcs->zsource);
      wcsutil_hdr("Redshift of the source", keyword, keyvalue, ncards,
         header, &status);
   }

   for (k = 0; k < 3; k++) {
      if (undefined(wcs->obsgeo[k])) continue;
      sprintf(keyword,  "OBSGEO-%c%c", xyz[k], alt);
      sprintf(keyvalue, "%20.12g", wcs->obsgeo[k]);
      wcsutil_hdr("[m] ITRF observatory coordinates", keyword, keyvalue,
         ncards, header, &status);
   }

   if (!undefined(wcs->mjdobs)) {
      sprintf(keyword,  "MJD-OBS");
      sprintf(keyvalue, "%20.12g", wcs->mjdobs);
      wcsutil_hdr("[d] MJD(UTC) at start of observation", keyword, keyvalue,
         ncards, header, &status);
   }

   if (!undefined(wcs->mjdavg)) {
      sprintf(keyword,  "MJD-AVG");
      sprintf(keyvalue, "%20.12g", wcs->mjdavg);
      wcsutil_hdr("[d] MJD(UTC) mid-observation time", keyword, keyvalue,
         ncards, header, &status);
   }

   if (wcs->dateavg[0]) {
      sprintf(keyword,  "DATE-AVG");
      sprintf(keyvalue, "'%s'", wcs->dateavg);
      wcsutil_hdr("ISO-8601 UTC date corresponding to MJD-AVG", keyword,
         keyvalue, ncards, header, &status);
   }

   if (wcs->dateobs[0]) {
      sprintf(keyword,  "DATE-OBS");
      sprintf(keyvalue, "'%s'", wcs->dateobs);
      wcsutil_hdr("ISO-8601 UTC date corresponding to MJD-OBS", keyword,
         keyvalue, ncards, header, &status);
   }

   /* Derived values. */
   printf("      types: %p\n           ", (void *)wcs->types);
   for (i = 0; i < naxis; i++) {
      printf("%5d", wcs->types[i]);
   }
   printf("\n");

   printf("     lngtyp: \"%s\"\n", wcs->lngtyp);
   printf("     lattyp: \"%s\"\n", wcs->lattyp);
   printf("        lng: %d\n", wcs->lng);
   printf("        lat: %d\n", wcs->lat);
   printf("       spec: %d\n", wcs->spec);
   printf("   cubeface: %d\n", wcs->cubeface);

   return 0;
}
@


4.2.1.4
log
@Further development of wcshdo(), now does binary table image array and pixel
list headers.
@
text
@d30 1
a30 1
*   $Id: wcshdr.c,v 4.2.1.3 2007/07/27 07:23:45 cal103 Exp cal103 $
a37 1
#include "wcsutil.h"
d40 1
a52 4
void wcshdo_util(int, const char [], const char [], int, const char [], int,
   int, int, char, int, int [], char [], const char [], int *, char **,
   int *);

d402 1
a402 3
int wcshdo(int relax, struct wcsprm *wcs, int *ncards, char **header)

/* CUBEFACE and STOKES handling? */
d405 3
a407 4
   char alt, comment[72], keyvalue[72], keyword[16], obsg[8] = "OBSG?",
        obsgeo[8] = "OBSGEO-?", ptype, xtype, xyz[] = "XYZ";
   int  bintab, col0, *colax, colnum, i, j, k, naxis, pixlist, primage,
        status;
a424 2

   /* These are mainly for convenience. */
a425 16
   if (alt == ' ') alt = '\0';
   colnum = wcs->colnum;
   colax  = wcs->colax;

   primage = 0;
   bintab  = 0;
   pixlist = 0;
   if (colnum) {
      bintab  = 1;
      col0 = colnum;
   } else if (colax[0]) {
      pixlist = 1;
      col0 = colax[0];
   } else {
      primage = 1;
   }
d427 4
a431 9
   /* WCS dimension. */
   if (!pixlist) {
      sprintf(keyvalue, "%20d", naxis);
      wcshdo_util(relax, "WCSAXES", "WCAX", 0, 0x0, 0, 0, 0, alt,
         colnum, colax, keyvalue, "Number of coordinate axes",
         ncards, header, &status);
   }

   /* Reference pixel coordinates. */
d433 1
d435 1
a435 2
      wcshdo_util(relax, "CRPIX", "CRP", WCSHDO_CRPX, "CRPX", 0, j+1, 0, alt,
         colnum, colax, keyvalue, "Pixel coordinate of reference point",
d448 1
a448 1

d450 2
a451 4
         wcshdo_util(relax, "PC", bintab ? "PC" : "P", WCSHDO_TPC,
            bintab ? 0x0 : "PC", i+1, j+1, 0, alt, colnum, colax, keyvalue,
            "Coordinate transformation matrix element",
            ncards, header, &status);
d457 1
d462 1
a462 2
      wcshdo_util(relax, "CDELT", "CDE", WCSHDO_CRPX, "CDLT", i+1, 0, 0, alt,
         colnum, colax, keyvalue, comment, ncards, header, &status);
d467 1
d472 1
a472 2
      wcshdo_util(relax, "CRVAL", "CRV", WCSHDO_CRPX, "CRVL", i+1, 0, 0, alt,
         colnum, colax, keyvalue, comment, ncards, header, &status);
d478 1
a478 1

d480 2
a481 3
      wcshdo_util(relax, "CUNIT", "CUN", WCSHDO_CRPX, "CUNI", i+1, 0, 0, alt,
         colnum, colax, keyvalue, "Units of coordinate increment and value",
         ncards, header, &status);
d487 1
a487 1

d539 2
d542 27
a568 2
      wcshdo_util(relax, "CTYPE", "CTY", WCSHDO_CRPX, "CTYP", i+1, 0, 0, alt,
         colnum, colax, keyvalue, comment, ncards, header, &status);
d573 1
d584 2
a585 8
            if (primage) {
               sprintf(keyword, "LONPOLE%c", alt);
            } else if (bintab) {
               sprintf(keyword, "LONP%d%c", colnum, alt);
            } else {
               sprintf(keyword, "LONP%d%c", colax[(wcs->pv[k]).i - 1], alt);
            }
            sprintf(comment, "[deg] alias for %s (has precedence)", keyword);
d588 2
a589 8
            if (primage) {
               sprintf(keyword, "LATPOLE%c", alt);
            } else if (bintab) {
               sprintf(keyword, "LATP%d%c", colnum, alt);
            } else {
               sprintf(keyword, "LATP%d%c", colax[(wcs->pv[k]).i - 1], alt);
            }
            sprintf(comment, "[deg] alias for %s (has precedence)", keyword);
d597 1
a597 4

      wcshdo_util(relax, "PV", "V", WCSHDO_PV, "PV", wcs->pv[k].i, -1,
         wcs->pv[k].m, alt, colnum, colax, keyvalue, comment,
         ncards, header, &status);
d601 1
d603 1
a603 4

      wcshdo_util(relax, "PS", "S", WCSHDO_PV, "PS", wcs->ps[k].i, -1,
         wcs->ps[k].m, alt, colnum, colax, keyvalue,
         "Coordinate transformation parameter",
a606 30
   /* Celestial and spectral transformation parameters. */
   if (!undefined(wcs->lonpole)) {
      sprintf(keyvalue, "%20.12g", wcs->lonpole);
      wcshdo_util(relax, "LONPOLE", "LONP", 0, 0x0, 0, 0, 0, alt,
         colnum, colax, keyvalue, "[deg] Native longitude of celestial pole",
         ncards, header, &status);
   }

   if (!undefined(wcs->latpole)) {
      sprintf(keyvalue, "%20.12g", wcs->latpole);
      wcshdo_util(relax, "LATPOLE", "LATP", 0, 0x0, 0, 0, 0, alt,
         colnum, colax, keyvalue, "[deg] Native latitude of celestial pole",
         ncards, header, &status);
   }

   if (!undefined(wcs->restfrq)) {
      sprintf(keyvalue, "%20.12g", wcs->restfrq);
      wcshdo_util(relax, "RESTFRQ", "RFRQ", 0, 0x0, 0, 0, 0, alt,
         colnum, colax, keyvalue, "[Hz] Line rest frequency",
         ncards, header, &status);
   }

   if (!undefined(wcs->restwav)) {
      sprintf(keyvalue, "%20.12g", wcs->restwav);
      wcshdo_util(relax, "RESTWAV", "RWAV", 0, 0x0, 0, 0, 0, alt,
         colnum, colax, keyvalue, "[Hz] Line rest wavelength",
         ncards, header, &status);
   }

   /* Coordinate system title. */
d608 1
d610 2
a611 10
      if (bintab) {
         wcshdo_util(relax, "WCSNAME", "WCSN", 0, 0x0, 0, 0, 0, alt,
            colnum, colax, keyvalue, "Coordinate system title",
            ncards, header, &status);
      } else {
         /* TWCS was a mistake. */
         wcshdo_util(relax, "WCSNAME", "TWCS", WCSHDO_WCSN, "WCSN", 0, 0, 0,
            alt, colnum, colax, keyvalue, "Coordinate system title",
            ncards, header, &status);
      }
a613 1
   /* Coordinate axis title. */
d617 1
a617 1

d619 1
a619 2
         wcshdo_util(relax, "CNAME", "CNA", WCSHDO_CNAM, "CNAM", i+1, 0, 0,
            alt, colnum, colax, keyvalue, "Axis name for labelling purposes",
a623 1
   /* Random error in coordinate. */
d627 1
a627 1

d632 1
a632 2
         wcshdo_util(relax, "CRDER", "CRD", WCSHDO_CNAM, "CRDE", i+1, 0, 0,
            alt, colnum, colax, keyvalue, comment, ncards, header, &status);
a635 1
   /* Systematic error in coordinate. */
d639 1
a639 1

d644 1
a644 2
         wcshdo_util(relax, "CSYER", "CSY", WCSHDO_CNAM, "CSYE", i+1, 0, 0,
            alt, colnum, colax, keyvalue, comment, ncards, header, &status);
a647 1
   /* Equatorial coordinate system type. */
d649 1
d651 2
a652 3
      wcshdo_util(relax, "RADESYS", "RADE", 0, 0x0, 0, 0, 0, alt,
         colnum, colax, keyvalue, "Equatorial coordinate system", 
         ncards, header, &status);
a654 1
   /* Equinox of equatorial coordinate system. */
d656 1
d658 1
a658 2
      wcshdo_util(relax, "EQUINOX", "EQUI", 0, 0x0, 0, 0, 0, alt,
         colnum, colax, keyvalue, "[yr] Equinox of equatorial coordinates",
a661 1
   /* Reference frame of spectral coordinates. */
d663 1
d665 2
a666 3
      wcshdo_util(relax, "SPECSYS", "SPEC", 0, 0x0, 0, 0, 0, alt,
         colnum, colax, keyvalue, "Reference frame of spectral coordinates",
         ncards, header, &status);
a668 1
   /* Reference frame of spectral observation. */
d670 1
d672 2
a673 3
      wcshdo_util(relax, "SSYSOBS", "SOBS", 0, 0x0, 0, 0, 0, alt,
         colnum, colax, keyvalue, "Reference frame of spectral observation",
         ncards, header, &status);
a675 1
   /* Observer's velocity towards source. */
d677 1
d679 2
a680 3
      wcshdo_util(relax, "VELOSYS", "VSYS", 0, 0x0, 0, 0, 0, alt,
         colnum, colax, keyvalue, "[m/s] Velocity towards source",
         ncards, header, &status);
a682 1
   /* Reference frame of source redshift. */
d684 1
d686 1
a686 2
      wcshdo_util(relax, "SSYSSRC", "SSRC", 0, 0x0, 0, 0, 0, alt,
         colnum, colax, keyvalue, "Reference frame of source redshift",
a689 1
   /* Redshift of the source. */
d691 1
d693 2
a694 3
      wcshdo_util(relax, "ZSOURCE", "ZSOU", 0, 0x0, 0, 0, 0, alt,
         colnum, colax, keyvalue, "Redshift of the source",
         ncards, header, &status);
a696 1
   /* Observatory coordinates. */
d699 1
a699 1

d701 2
a702 5
      sprintf(comment, "[m] ITRF observatory %c-coordinate", xyz[k]);
      obsgeo[7] = xyz[k];
      obsg[4]   = xyz[k];
      wcshdo_util(relax, obsgeo, obsg, 0, 0x0, 0, 0, 0, ' ',
         colnum, colax, keyvalue, comment, ncards, header, &status);
a704 1
   /* MJD of observation. */
d706 1
d708 2
a709 12

      strcpy(comment, "[d] MJD of observation");
      if (wcs->dateobs[0]) {
         if (primage || (relax & 1) == 0) {
            sprintf(comment+22, " matching DATE-OBS", alt);
         } else {
            sprintf(comment+22, " matching DOBS%d", col0);
         }
      }

      wcshdo_util(relax, "MJD-OBS", "MJDOB", 0, 0x0, 0, 0, 0, ' ',
         colnum, colax, keyvalue, comment, ncards, header, &status);
a711 1
   /* MJD mid-observation time. */
d713 1
d715 2
a716 12

      strcpy(comment, "[d] MJD mid-observation");
      if (wcs->dateavg[0]) {
         if (primage) {
            sprintf(comment+23, " matching DATE-AVG", alt);
         } else {
            sprintf(comment+23, " matching DAVG%d", col0);
         }
      }

      wcshdo_util(relax, "MJD-AVG", "MJDA", 0, 0x0, 0, 0, 0, ' ',
         colnum, colax, keyvalue, comment, ncards, header, &status);
a718 25
   /* ISO-8601 date corresponding to MJD-OBS. */
   if (wcs->dateobs[0]) {
      sprintf(keyvalue, "'%s'", wcs->dateobs);

      strcpy(comment, "ISO-8601 observation date");
      if (!undefined(wcs->mjdobs)) {
         if (primage) {
            sprintf(comment+25, " matching MJD-OBS", alt);
         } else {
            sprintf(comment+25, " matching MJDOB%d", col0);
         }
      }

      if (relax & 1) {
         /* Allow DOBSn. */
         wcshdo_util(relax, "DATE-OBS", "DOBS", WCSHDO_DOBS, 0x0, 0, 0, 0,
            ' ', colnum, colax, keyvalue, comment, ncards, header, &status);
      } else {
         /* Force DATE-OBS. */
         wcshdo_util(relax, "DATE-OBS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0,
            0x0, keyvalue, comment, ncards, header, &status);
      }
   }

   /* ISO-8601 date corresponding to MJD-OBS. */
d720 1
d722 2
a723 12

      strcpy(comment, "ISO-8601 mid-observation date");
      if (!undefined(wcs->mjdavg)) {
         if (primage) {
            sprintf(comment+29, " matching MJD-AVG", alt);
         } else {
            sprintf(comment+29, " matching MJDA%d", col0);
         }
      }

      wcshdo_util(relax, "DATE-AVG", "DAVG", 0, 0x0, 0, 0, 0, ' ',
         colnum, colax, keyvalue, comment, ncards, header, &status);
d726 5
a730 38
   return 0;
}

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

void wcshdo_util(
   int relax,
   const char pikey[],
   const char tbkey[],
   int level,
   const char tlkey[],
   int i,
   int j,
   int m,
   char alt,
   int  btcol,
   int  plcol[],
   char keyvalue[],
   const char keycomment[],
   int  *ncards,
   char **header,
   int  *status)

{
   char ch0, ch1, *hptr, keyword[16], *kptr;
   int  nbyte, nc = 47, nv;

   if (*status) return;

   /* Reallocate memory in blocks of 2880 bytes. */
   if ((*ncards)%32 == 0) {
      nbyte = ((*ncards)/32 + 1) * 2880;
      if (!(hptr = realloc(*header, nbyte))) {
         *status = 2;
         return;
      }

      *header = hptr;
d733 4
a736 82
   /* Construct the keyword. */
   if (alt == ' ') alt = '\0';
   if (btcol) {
      /* Binary table image array. */
      if (i > 0 && j) {
         if (j > 0) {
            sprintf(keyword, "%d%d%s%d%c", i, j, tbkey, btcol, alt);
         } else {
            sprintf(keyword, "%d%s%d_%d%c", i, tbkey, btcol, m, alt);
         }
      } else if (i > 0) {
         sprintf(keyword, "%d%s%d%c", i, tbkey, btcol, alt);
      } else if (j > 0) {
         sprintf(keyword, "%d%s%d%c", j, tbkey, btcol, alt);
      } else {
         sprintf(keyword, "%s%d%c", tbkey, btcol, alt);
      }

      if ((strlen(keyword) < 8) && tlkey && (relax & level)) {
         /* Use the long form. */
         if (i > 0 && j) {
            if (j > 0) {
               sprintf(keyword, "%d%d%s%d%c", i, j, tlkey, btcol, alt);
            } else {
               sprintf(keyword, "%d%s%d_%d%c", i, tlkey, btcol, m, alt);
            }
         } else if (i > 0) {
            sprintf(keyword, "%d%s%d%c", i, tlkey, btcol, alt);
         } else if (j > 0) {
            sprintf(keyword, "%d%s%d%c", j, tlkey, btcol, alt);
         } else {
            sprintf(keyword, "%s%d%c", tlkey, btcol, alt);
         }
      }

   } else if (plcol && plcol[0]) {
      /* Pixel list. */
      if (i > 0 && j) {
         if (j > 0) {
            sprintf(keyword, "T%s%d_%d%c", tbkey, plcol[i-1], plcol[j-1], alt);
         } else {
            sprintf(keyword, "T%s%d_%d%c", tbkey, plcol[i-1], m, alt);
         }
      } else if (i > 0) {
         sprintf(keyword, "T%s%d%c", tbkey, plcol[i-1], alt);
      } else if (j > 0) {
         sprintf(keyword, "T%s%d%c", tbkey, plcol[j-1], alt);
      } else {
         sprintf(keyword, "%s%d%c", tbkey, plcol[0], alt);
      }

      if ((strlen(keyword) < 8) && tlkey && (relax & level)) {
         /* Use the long form. */
         if (i > 0 && j) {
            if (j > 0) {
               sprintf(keyword, "T%s%d_%d%c", tlkey, plcol[i-1], plcol[j-1],
                  alt);
            } else {
               sprintf(keyword, "T%s%d_%d%c", tlkey, plcol[i-1], m, alt);
            }
         } else if (i > 0) {
            sprintf(keyword, "T%s%d%c", tlkey, plcol[i-1], alt);
         } else if (j > 0) {
            sprintf(keyword, "T%s%d%c", tlkey, plcol[j-1], alt);
         } else {
            sprintf(keyword, "%s%d%c", tlkey, plcol[0], alt);
         }
      }
   } else {
      if (i > 0 && j) {
         if (j > 0) {
            sprintf(keyword, "%s%d_%d%c", pikey, i, j, alt);
         } else {
            sprintf(keyword, "%s%d_%d%c", pikey, i, m, alt);
         }
      } else if (i > 0) {
         sprintf(keyword, "%s%d%c", pikey, i, alt);
      } else if (j > 0) {
         sprintf(keyword, "%s%d%c", pikey, j, alt);
      } else {
         sprintf(keyword, "%s%c", pikey, alt);
      }
d738 1
d740 6
a745 14
   /* Double-up single-quotes in the keyvalue. */
   hptr = keyvalue + 1;
   while (*hptr) {
      if (*hptr == '\'') {
         kptr = hptr++;
         if (*hptr) {
            ch0 = *kptr;
            while (*kptr) {
               ch1 = *(++kptr);
               *kptr = ch0;
               ch0 = ch1;
            }
         }
      }
d747 1
a747 11
      hptr++;
   }

   if ((nv = strlen(keyvalue) > 20)) {
      /* Rob the inline comment to make space for the keyvalue. */
      nc -= (nv - 20);
   }

   hptr = *header + (80 * ((*ncards)++));
   sprintf(hptr, "%-8.8s= %-20s / %-*.*s", keyword, keyvalue, nc, nc,
      keycomment);
@


4.2.1.5
log
@Replaced use of the obsolete term "card".
@
text
@d30 1
a30 1
*   $Id: wcshdr.c,v 4.2.1.4 2007/08/01 08:23:46 cal103 Exp cal103 $
d117 1
a117 1
   /* Collect information from the PSi_ma and PVi_ma keyvalues. */
d406 1
a406 1
int wcshdo(int relax, struct wcsprm *wcs, int *nkeyrec, char **header)
d417 2
a418 2
   *nkeyrec = 0;
   *header  = 0x0;
d458 1
a458 1
         nkeyrec, header, &status);
d466 1
a466 1
         nkeyrec, header, &status);
d483 1
a483 1
            nkeyrec, header, &status);
d494 1
a494 1
         colnum, colax, keyvalue, comment, nkeyrec, header, &status);
d504 1
a504 1
         colnum, colax, keyvalue, comment, nkeyrec, header, &status);
d514 1
a514 1
         nkeyrec, header, &status);
d574 1
a574 1
         colnum, colax, keyvalue, comment, nkeyrec, header, &status);
d617 1
a617 1
         nkeyrec, header, &status);
d626 1
a626 1
         nkeyrec, header, &status);
d634 1
a634 1
         nkeyrec, header, &status);
d641 1
a641 1
         nkeyrec, header, &status);
d648 1
a648 1
         nkeyrec, header, &status);
d655 1
a655 1
         nkeyrec, header, &status);
d664 1
a664 1
            nkeyrec, header, &status);
d669 1
a669 1
            nkeyrec, header, &status);
d681 1
a681 1
            nkeyrec, header, &status);
d695 1
a695 1
            alt, colnum, colax, keyvalue, comment, nkeyrec, header, &status);
d709 1
a709 1
            alt, colnum, colax, keyvalue, comment, nkeyrec, header, &status);
d717 2
a718 2
         colnum, colax, keyvalue, "Equatorial coordinate system",
         nkeyrec, header, &status);
d726 1
a726 1
         nkeyrec, header, &status);
d734 1
a734 1
         nkeyrec, header, &status);
d742 1
a742 1
         nkeyrec, header, &status);
d750 1
a750 1
         nkeyrec, header, &status);
d758 1
a758 1
         nkeyrec, header, &status);
d766 1
a766 1
         nkeyrec, header, &status);
d778 1
a778 1
         colnum, colax, keyvalue, comment, nkeyrec, header, &status);
d795 1
a795 1
         colnum, colax, keyvalue, comment, nkeyrec, header, &status);
d812 1
a812 1
         colnum, colax, keyvalue, comment, nkeyrec, header, &status);
d831 1
a831 1
            ' ', colnum, colax, keyvalue, comment, nkeyrec, header, &status);
d835 1
a835 1
            0x0, keyvalue, comment, nkeyrec, header, &status);
d853 1
a853 1
         colnum, colax, keyvalue, comment, nkeyrec, header, &status);
d875 1
a875 1
   int  *nkeyrec,
d886 2
a887 2
   if ((*nkeyrec)%32 == 0) {
      nbyte = ((*nkeyrec)/32 + 1) * 2880;
d1003 1
a1003 1
   hptr = *header + (80 * ((*nkeyrec)++));
@


4.2.1.6
log
@Fixed status handling in wcshdo().
@
text
@d30 1
a30 1
*   $Id: wcshdr.c,v 4.2.1.5 2007/08/02 04:53:25 cal103 Exp cal103 $
d414 1
a414 1
        status = 0;
d856 1
a856 1
   return status;
@


4.2.1.7
log
@Put CRVALia after CTYPEia in the orthodox ordering.
@
text
@d30 1
a30 1
*   $Id: wcshdr.c,v 4.2.1.6 2007/08/03 04:34:28 cal103 Exp cal103 $
d497 10
a576 10
   /* Coordinate value at reference point. */
   for (i = 0; i < naxis; i++) {
      sprintf(keyvalue, "%20.12g", wcs->crval[i]);
      comment[0] = '\0';
      if (wcs->cunit[i][0]) sprintf(comment, "[%s] ", wcs->cunit[i]);
      strcat(comment, "Coordinate value at reference point");
      wcshdo_util(relax, "CRVAL", "CRV", WCSHDO_CRPX, "CRVL", i+1, 0, 0, alt,
         colnum, colax, keyvalue, comment, nkeyrec, header, &status);
   }

@


4.2.1.8
log
@In wcsidx(), skip wcsprm structs associated with binary table image arrays
and pixel lists.  Added wcsbdx().  Made the names of the WCSHDO_* relaxation
macros more specific to their association with binary table image arrays and
pixel lists.
@
text
@d30 1
a30 1
*   $Id: wcshdr.c,v 4.2.1.7 2007/08/03 09:01:28 cal103 Exp cal103 $
d354 1
a354 1
   int a, iwcs;
d366 1
a366 33
   for (iwcs = 0; iwcs < nwcs; iwcs++, wcsp++) {
      if (wcsp->colnum || wcsp->colax[0]) continue;

      if (wcsp->alt[0] == ' ') {
         a = 0;
      } else {
         a = wcsp->alt[0] - 'A' + 1;
      }

      alts[a] = iwcs;
   }

   return 0;
}

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

int wcsbdx(int nwcs, struct wcsprm **wcs, int type, int alts[999][27])

{
   int a, i, iwcs, *ip;
   struct wcsprm *wcsp;

   for (ip = alts[0]; ip < alts[0] + 27*999; ip++) {
      *ip = -1;
   }

   if (wcs == 0x0) {
      return 1;
   }

   wcsp = *wcs;
   for (iwcs = 0; iwcs < nwcs; iwcs++, wcsp++) {
d373 1
a373 12
      if (type) {
         /* Pixel list. */
         if (wcsp->colax[0]) {
            for (i = 0; i < wcsp->naxis; i++) {
               alts[wcsp->colax[i] - 1][a] = iwcs;
            }
         }

      } else {
         /* Binary table image array. */
         if (wcsp->colnum) alts[wcsp->colnum - 1][a] = iwcs;
      }
d464 2
a465 2
      wcshdo_util(relax, "CRPIX", "CRP", WCSHDO_CRPXna, "CRPX", 0, j+1, 0,
         alt, colnum, colax, keyvalue, "Pixel coordinate of reference point",
d480 1
a480 1
         wcshdo_util(relax, "PC", bintab ? "PC" : "P", WCSHDO_TPCn_ka,
d493 2
a494 2
      wcshdo_util(relax, "CDELT", "CDE", WCSHDO_CRPXna, "CDLT", i+1, 0, 0,
         alt, colnum, colax, keyvalue, comment, nkeyrec, header, &status);
d502 3
a504 3
      wcshdo_util(relax, "CUNIT", "CUN", WCSHDO_CRPXna, "CUNI", i+1, 0, 0,
         alt, colnum, colax, keyvalue,
         "Units of coordinate increment and value", nkeyrec, header, &status);
d563 2
a564 2
      wcshdo_util(relax, "CTYPE", "CTY", WCSHDO_CRPXna, "CTYP", i+1, 0, 0,
         alt, colnum, colax, keyvalue, comment, nkeyrec, header, &status);
d573 2
a574 2
      wcshdo_util(relax, "CRVAL", "CRV", WCSHDO_CRPXna, "CRVL", i+1, 0, 0,
         alt, colnum, colax, keyvalue, comment, nkeyrec, header, &status);
d615 1
a615 1
      wcshdo_util(relax, "PV", "V", WCSHDO_PVn_ma, "PV", wcs->pv[k].i, -1,
d623 1
a623 1
      wcshdo_util(relax, "PS", "S", WCSHDO_PVn_ma, "PS", wcs->ps[k].i, -1,
d667 1
a667 1
         wcshdo_util(relax, "WCSNAME", "TWCS", WCSHDO_WCSNna, "WCSN", 0, 0, 0,
d679 1
a679 1
         wcshdo_util(relax, "CNAME", "CNA", WCSHDO_CNAMna, "CNAM", i+1, 0, 0,
d694 1
a694 1
         wcshdo_util(relax, "CRDER", "CRD", WCSHDO_CNAMna, "CRDE", i+1, 0, 0,
d708 1
a708 1
         wcshdo_util(relax, "CSYER", "CSY", WCSHDO_CNAMna, "CSYE", i+1, 0, 0,
d830 1
a830 1
         wcshdo_util(relax, "DATE-OBS", "DOBS", WCSHDO_DOBSn, 0x0, 0, 0, 0,
@


4.2.1.9
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: wcshdr.c,v 4.2.1.8 2007/12/04 01:01:39 cal103 Exp cal103 $
@


4.2.1.10
log
@"Inline comment" -> "keycomment".
@
text
@d31 1
a31 1
    $Id: wcshdr.c,v 4.2.1.9 2007/12/04 01:22:51 cal103 Exp cal103 $
d1043 1
a1043 1
      /* Rob the keycomment to make space for the keyvalue. */
@


4.2.1.11
log
@Eliminated compiler warnings in wcshdo().
@
text
@d31 1
a31 1
    $Id: wcshdr.c,v 4.2.1.10 2007/12/22 07:28:05 cal103 Exp cal103 $
d452 1
a452 1
/* ::: CUBEFACE and STOKES handling? */
d459 1
d832 1
a832 1
            sprintf(comment+22, " matching DATE-OBS");
d849 1
a849 1
            sprintf(comment+23, " matching DATE-AVG");
d866 1
a866 1
            sprintf(comment+25, " matching MJD-OBS");
d890 1
a890 1
            sprintf(comment+29, " matching MJD-AVG");
@


4.2.1.12
log
@Reworked the API to wcsbdx() to make it a little more practical in everyday
use.
@
text
@d31 1
a31 1
    $Id: wcshdr.c,v 4.2.1.11 2007/12/26 03:04:37 cal103 Exp cal103 $
d384 1
a384 1
int wcsbdx(int nwcs, struct wcsprm **wcs, int type, short alts[1000][28])
d387 1
a387 2
   short  *ip;
   int    a, i, icol, iwcs;
d390 1
a390 1
   for (ip = alts[0]; ip < alts[0] + 28*1000; ip++) {
a393 4
   for (icol = 0; icol < 1000; icol++) {
      alts[icol][27] = 0;
   }

d410 1
a410 2
               alts[wcsp->colax[i]][a]  = iwcs;
               alts[wcsp->colax[i]][27]++;
a411 3
         } else if (!wcsp->colnum) {
            alts[0][a]  = iwcs;
            alts[0][27]++;
d416 1
a416 7
         if (wcsp->colnum) {
           alts[wcsp->colnum][a] = iwcs;
           alts[wcsp->colnum][27]++;
         } else if (!wcsp->colax[0]) {
            alts[0][a]  = iwcs;
            alts[0][27]++;
         }
@


4.1
log
@WCSLIB 4.1: added wcshdr_errmsg[]; implementation of wcstab().
@
text
@d3 1
a3 1
*   WCSLIB 4.1 - an implementation of the FITS WCS standard.
d30 1
a30 1
*   $Id: wcshdr.c,v 4.0 2005/02/04 06:14:07 cal103 Exp cal103 $
a309 1
            wtbp->kind   = 0;
@


4.0
log
@WCSLIB 4.0: changed from LGPL to GPL; new function wcsidx(); check that
wcs != 0 in wcsvfree().
@
text
@d3 1
a3 1
*   WCSLIB 4.0 - an implementation of the FITS WCS standard.
d30 1
a30 1
*   $Id: wcshdr.c,v 3.6 2004/08/24 08:21:45 cal103 Exp cal103 $
d34 1
d36 2
d39 303
a341 1
#include "wcs.h"
d355 1
a355 1
   if (wcs == 0) {
d381 1
a381 1
   if (wcs == 0) {
d393 1
a393 1
   *wcs = 0;
@


3.6
log
@WCSLIB 3.6
@
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: wcshdr.c,v 3.5 2004/06/28 04:26:43 mcalabre Exp mcalabre $
d40 1
a40 1
int wcsvfree(nwcs, wcs)
d42 29
a70 2
int *nwcs;
struct wcsprm **wcs;
d73 6
a78 2
  int a, status = 0;
  struct wcsprm *wcsp;
d80 4
a83 4
  wcsp = *wcs;
  for (a = 0; a < *nwcs; a++, wcsp++) {
    status |= wcsfree(wcsp);
  }
d85 1
a85 1
  free(*wcs);
d87 2
a88 2
  *nwcs = 0;
  *wcs = 0;
d90 1
a90 1
  return status;
@


3.5
log
@WCSLIB 3.5: initial revision.
@
text
@d3 1
a3 1
*   WCSLIB 3.5 - an implementation of the FITS WCS convention.
d30 1
a30 1
*   $Id$
@


0.0
log
@Empty revision
@
text
@d1 60
@
