/* @(#)fitswdb.c 14.5 (ES0-DMD) 07/18/00 15:55:38 */ /*=========================================================================== Copyright (C) 1995 European Southern Observatory (ESO) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, MA 02139, USA. Corresponding concerning ESO-MIDAS should be addressed as follows: Internet e-mail: midas@eso.org Postal address: European Southern Observatory Data Management Division Karl-Schwarzschild-Strasse 2 D 85748 Garching bei Muenchen GERMANY ===========================================================================*/ /*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ .COPYRIGHT (c) 1996 European Southern Observatory .IDENT fitswdb.c .LAUGUAGE C .AUTHOR P.Grosbol ESO/IPG .KEYWORDS FITS header, MIDAS descriptor block .COMMENT write MIDAS descriptor to FITS header .VERSION 1.0 1991-Mar-17 : Creation, PJG .VERSION 1.1 1992-Sep-10 : Add DCTL,ZCTL,TCTL flags, PJG .VERSION 1.2 1993-Jul-06 : Write comment from descriptor, PJG .VERSION 1.3 1993-Sep-03 : Correct error in descriptor help, PJG .VERSION 1.4 1993-Sep-16 : Check for empty descriptor help, PJG .VERSION 1.5 1993-Oct-26 : Update to new SC + prototypes, PJG .VERSION 1.6 1994-Jun-28 : Change fitswkd calls + R*4 desc, PJG .VERSION 1.7 1995-Sep-27 : Correct read of R4-desc with DCTL, PJG .VERSION 1.8 1995-Oct-12 : Write simple desc. as prime keywords, PJG .VERSION 1.9 1995-Nov-04 : Correct error in char. count, PJG .VERSION 2.0 1996-Oct-22 : Update for new long descriptor names, PJG .VERSION 2.1 1997-Jul-29 : Terminate string keywords with NULL, PJG 020111 ---------------------------------------------------------------------*/ #include #include #include #include #include #include #define MXLB 81 /* max. char. in line buffer */ typedef struct { /* Descriptor structure */ char name[MXMDN]; /* Name of descriptor */ char type; /* Type of descriptor */ int ne; /* No. of elements in desc. */ int nbp; /* No. of bytes per element */ char class; /* FITS keyword class */ DTOKW *dtk; /* Descriptor->keyword map */ } MDESC; int fitswdb(mfd,ddflag) /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ .PURPOSE write MIDAS descriptor to FITS header .RETURN return status 0:OK, -1:error ---------------------------------------------------------------------*/ int mfd; /* IN: MIDAS file number */ int ddflag; /* IN: = 1, if DATAMIN,MAX already written */ { char cn, type, *pc, *pd, *ph, *pdx; char com[MXLB], cval[MXLB], line[MXLB], help[MXLB], *hkb[MXHKW]; char *ymddate(); int i, n, nc, nn, nv, nom, nof, noh, nod; int ns, ne, nbp, ival, null, unit[4]; float fval, f[3]; double dval, d[3]; DKMAP *dk; DTOKW *dtk; KWDEF *kwd; HKWL *hkl; MDESC *mdesc, *md; char dname[52], dtype[12]; int dbytelem, dnoelem, dhnc; /* Get total no. of descriptors */ (void) SCDRDX(mfd,2,dname,dtype,&dbytelem,&dnoelem,&dhnc); mdesc = (MDESC *) calloc( dnoelem+1, sizeof(MDESC)); /* get buffer */ if (!mdesc) return -1; /* error if no buffer available */ md = mdesc; (void) SCDRDX(mfd,10,md->name,dtype,&dbytelem,&dnoelem,&dhnc); nom = noh = nof = nod = 0; while (md->name[0] != ' ') { /* go through all desc. */ md->type = dtype[0]; md->ne = dnoelem; md->nbp = dbytelem; dk = dkm; while (dk->desc && strcmp(md->name,dk->desc)) dk++; if (dk->desc) { /* use descriptor-to-keyword map */ md->dtk = dk->dtk; if (md->dtk) { md->class = 'M'; nom++; } else md->class = '\0'; } else if ((md->name[0] == '_' || /* HIERARCH keyword format */ strchr(md->name,'.')) && (md->ne==1 || (md->type=='C' && md->ne<68 && md->nbp==1))) { md->class = 'H'; noh++; } else if (strlen(md->name)<9 && (md->ne==1 || (md->type=='C' && md->ne<68 && md->nbp==1))) { md->class = 'F'; /* prime FITS keyword */ nof++; } else { /* else write in MIDAS descriptor format */ md->class = 'D'; nod++; } md++; get_next_descr: (void) SCDRDX(mfd,10,md->name,dtype,&dbytelem,&dnoelem,&dhnc); if (strncmp(md->name,"DATAM",5) == 0) { if ( (ddflag == 1) && /* DATAMIN already written */ ( (strcmp(md->name,"DATAMAX") == 0) || (strcmp(md->name,"DATAMIN") == 0) ) ) goto get_next_descr; } } md = mdesc; nv = 0; hkb[0] = ""; if (nom) while (md->name[0]) { /* go through all descriptors */ if (md->class=='M') { /* write mapped descriptor */ dtk = md->dtk; ne = md->ne; nbp = md->nbp; if (md->type=='C' && nbp==1) { nbp = ne; ne = 1; } while (dtk->no) { if (dtk->no<0) { ns = 1; n = ne; } else { ns = dtk->no; n = (netype) { case 'L' : SCDRDL(mfd,md->name,ns,1,&nv,&ival,unit,&null); if (dtk->ctl==ZCTL && ival==0) break; sprintf(com,"MIDAS desc.: %s(%d)",md->name,ns); fitswkl(dtk->kw,hkb,0,-1,ival,com); break; case 'I' : SCDRDI(mfd,md->name,ns,1,&nv,&ival,unit,&null); if (dtk->ctl==ZCTL && ival==0) break; sprintf(com,"MIDAS desc.: %s(%d)",md->name,ns); fitswki(dtk->kw,hkb,0,-1,ival,com); break; case 'R' : SCDRDR(mfd,md->name,ns,1,&nv,&fval,unit,&null); sprintf(com,"MIDAS desc.: %s(%d)",md->name,ns); if (dtk->ctl==ZCTL && fval==0.0) break; dval = fval; if (dtk->ctl==TCTL) dval *= 3600.0; if (dtk->ctl!=DCTL) fitswkd(dtk->kw,hkb,0,-1,dval,"%20.7G",com); else { SCDRDR(mfd,md->name,ns,3,&nv,f,unit,&null); d[0] = f[0]; d[1] = f[1]; d[2] = f[2]; fitswks(dtk->kw,hkb,0,-1,ymddate(d[0],d[1],d[2]),com); } break; case 'D' : SCDRDD(mfd,md->name,ns,1,&nv,&dval,unit,&null); sprintf(com,"MIDAS desc.: %s(%d)",md->name,ns); if (dtk->ctl==ZCTL && dval==0.0) break; if (dtk->ctl==TCTL) dval *= 3600.0; if (dtk->ctl!=DCTL) fitswkd(dtk->kw,hkb,0,-1,dval,"%20.12G",com); else { SCDRDD(mfd,md->name,ns,3,&nv,d,unit,&null); fitswks(dtk->kw,hkb,0,-1,ymddate(d[0],d[1],d[2]),com); } break; case 'C' : if (dtk->ctl==NCTL || dtk->ctl==SCTL) { nc = (MXLBname,1,ns,nc,&nv,cval,unit,&null); cval[nv] = '\0'; for (nn=0; nnctl==SCTL) { ival = nv-1; while (ival && cval[ival]==' ') ival--; cval[++ival] = '\0'; } n = 0; sprintf(com,"MIDAS desc.: %s(%d)",md->name,ns); fitswks(dtk->kw,hkb,0,-1,cval,com); } else if (dtk->ctl==CCTL) { n = 0; ns = 1; while (ns<=nbp) { nn = (nbp-ns<71) ? nbp-ns+1 : 72; SCDRDC(mfd,md->name,1,ns,nn,&nv,cval,unit,&null); for (nn=0; nnkw,cval); } } } ns++; } dtk++; } } md++; } md = mdesc; nv = 0; hkb[0] = ""; if (nof) while (md->name[0]) { /* go through all descriptors */ if (md->class=='F') { /* write simple descriptor */ dtk = md->dtk; ne = md->ne; nbp = md->nbp; if (md->type=='C' && nbp==1) { nbp = ne; ne = 1; } switch (md->type) { case 'L' : SCDHRL(mfd,md->name,1,1,&nv,&ival,help,MXLB,unit,&null); fitswkl(md->name,hkb,0,-1,ival,help); break; case 'I' : SCDHRI(mfd,md->name,1,1,&nv,&ival,help,MXLB,unit,&null); fitswki(md->name,hkb,0,-1,ival,help); break; case 'R' : SCDHRR(mfd,md->name,1,1,&nv,&fval,help,MXLB,unit,&null); dval = fval; fitswkd(md->name,hkb,0,-1,dval,"%9.6G",help); break; case 'D' : SCDHRD(mfd,md->name,1,1,&nv,&dval,help,MXLB,unit,&null); fitswkd(md->name,hkb,0,-1,dval,"%15.12G",help); break; case 'C' : nc = (MXLBname,1,1,nc,&nv,cval,help,MXLB,unit,&null); cval[nv--] = '\0'; while (0<=nv && cval[nv]==' ') cval[nv--] = '\0'; fitswks(md->name,hkb,0,-1,cval,help); break; } } md++; } md = mdesc; nv = 0; hkb[0] = ""; if (noh) while (md->name[0]) { /* go through all descriptors */ if (md->class=='H') { /* write hierarchical keywords */ dtk = md->dtk; ne = md->ne; nbp = md->nbp; if (md->type=='C' && nbp==1) { nbp = ne; ne = 1; } nn = 0; pc = com; pd = md->name; hkl = hkwgrp; if (md->name[0]=='_') { do { while (*(ph=hkl->abrv)) { pdx = pd; while (*ph == *pdx) ph++, pdx++; if (!(cn = *ph) || cn=='#') break; hkl++; } if (!(ph=hkl->name)) break; pd = pdx; hkb[nn++] = pc; while ((*pc = *ph) != cn) pc++, ph++; if (cn) while ('0'<=*pd && *pd<='9') *pc++ = *pd++; *pc++ = '\0'; kwd = (KWDEF *) hkl->kw; hkl = (HKWL *) hkl->next; } while (*pd!='_' && hkl); if (*pd++ == '_') { hkb[nn++] = pc; while (*pc++ = *pd++); } else nn = 0; } else { line[0] = '\0'; strcat(line,md->name); /* get copy of descriptor name */ nn = 0; hkb[nn++] = strtok(line,"."); /* split it into levels */ while (hkb[nn] = strtok(NULL,".")) nn++; } if (1type) { case 'L' : SCDHRL(mfd,md->name,1,1,&nv,&ival,help,MXLB,unit,&null); fitswkl("HIERARCH",hkb,nn,-1,ival,help); break; case 'I' : SCDHRI(mfd,md->name,1,1,&nv,&ival,help,MXLB,unit,&null); fitswki("HIERARCH",hkb,nn,-1,ival,help); break; case 'R' : SCDHRR(mfd,md->name,1,1,&nv,&fval,help,MXLB,unit,&null); dval = fval; fitswkd("HIERARCH",hkb,nn,-1,dval,"%9.6G",help); break; case 'D' : SCDHRD(mfd,md->name,1,1,&nv,&dval,help,MXLB,unit,&null); fitswkd("HIERARCH",hkb,nn,-1,dval,"%15.12G",help); break; case 'C' : nc = (MXLBname,1,1,nc,&nv,cval,help,MXLB,unit,&null); cval[nv--] = '\0'; while (0<=nv && cval[nv]==' ') cval[nv--] = '\0'; fitswks("HIERARCH",hkb,nn,-1,cval,help); break; } } } md++; } if (nod) { fitswkc("",""); fitswkc("HISTORY"," ESO-DESCRIPTORS START ................"); md = mdesc; nv = 0; hkb[0] = ""; while (md->name[0]) { /* go though all descriptors */ if (md->class=='D') /* write other midas descriptor */ fitswmd(mfd,md->name); md++; } fitswkc("HISTORY"," ESO-DESCRIPTORS END ................"); fitswkc("",""); } free((char *) mdesc); return 0; }