NEW

AUSTAL2000 (modifiziert)

TalDtb.c

//================================================================== TalDtb.c

//

// Calculation of concentration statistics

// =======================================

//

// Copyright (C) Umweltbundesamt, 14191 Berlin, Germany, 2002-2005

// Copyright (C) Janicke Consulting, 26427 Dunum, Germany, 2002-2005

// email: info@austal2000.de

//

// 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 Mass Ave, Cambridge, MA 02139, USA.

//

// last change: 2006-10-26 lj

//

//==========================================================================



#include 



#define  STDMYMAIN  DtbMain

#include "IBJmsg.h"

#include "IBJary.h"

#include "IBJstd.h"

static char *eMODn = "TalDtb";



/*=========================================================================*/



STDPGM(tstdtb, DtbServer, 2, 3, 0);



/*=========================================================================*/



#include "genutl.h"

#include "genio.h"



#include "TalNms.h"

#include "TalTmn.h"

#include "TalGrd.h"

#include "TalPrm.h"

#include "TalMod.h"

#include "TalDos.h"

#include "TalDtb.h"

#include "TalZet.h"

#include "IBJary.h"

#include "IBJdmn.h"

#include "IBJtxt.h"

#include "TalBlm.h"

#include "TalDtb.nls"



static char Hdr[GENHDRLEN], DefName[256];

static long T1;

static int PartTotal, PartNew, PartDrop;                        //-2001-06-29



/*================================================================ DtbDos2Con

*/

long DtbDos2Con(        /* calculate concentration      */

long idos,              /* ident of dose field          */

long icon,              /* ident of concentration field */

int k1, int k2 )        /* subrange                     */

  {

  dP(DtbDos2Con);

  int i, j, k, l, gp, gl, gi, nx, ny, nz, nc, sz, scatter, ng;

  long t1, t2, igrd, usage, ivol, invalid;

  char t1s[40], t2s[40], name[256];				//-2004-11-26

  float area, f, *sk, dd, scale, *pc, *pd, rgf, dos, dsq, dev;

  float zd, *pv;

  ARYDSC *pdos, *pcon, *pgrd, *pvol;

  GRDPARM *pgp;

  strcpy(name, NmsName(idos));

  vLOG(4)("converting dose %s to concentration", name);

  gp = XTR_GROUP(idos);

  gl = XTR_LEVEL(idos);

  gi = XTR_GRIDN(idos);

  igrd = IDENT(GRDpar, 0, gl, gi);

  pgrd = TmnAttach(igrd, NULL, NULL, 0, NULL);  if (!pgrd)              eX(1);

  pgp = pgrd->start;

  dd = pgp->dd;

  zd = pgp->zscl;                     //-98-08-22

  sk = GrdParr->start;

  if (zd > 0) {                       //-98-08-22

    ivol = IDENT(GRDarr, GRD_IVM, gl, gi);

    pvol = TmnAttach(ivol, NULL, NULL, 0, NULL);  if (!pvol)            eX(30);

    }

  else  pvol = NULL;

  TmnInfo(idos, &t1, &t2, &usage, NULL, NULL);

  if (!(usage & TMN_DEFINED))                                           eX(2);

  invalid = usage & TMN_INVALID;

  strcpy(t1s, TmString(&t1));

  strcpy(t2s, TmString(&t2));

  if (T1 > TmMin() && (t2<=T1 || t1>T1))                                eX(20);

  pdos = TmnAttach(idos, &t1, &t2, 0, NULL);  if (!pdos)                eX(3);

  nx = pdos->bound[0].hgh;

  ny = pdos->bound[1].hgh;

  nz = pdos->bound[2].hgh;

  nc = pdos->bound[3].hgh + 1;

  sz = pdos->elmsz;

  if (icon) {

    if (k1 < -1)  k1 = -1;

    if (k2>nz || k2
    /* sz = sizeof(float);                    -05feb96-*/

    }

  else {

    icon = IDENT(CONtab, gp, gl, gi);

    k1 = -1;

    k2 = nz;

    }

  TmnInfo(icon, NULL, NULL, &usage, NULL, NULL);

  if (usage & TMN_DEFINED) {

    pcon = TmnAttach(icon, NULL, NULL, TMN_MODIFY, NULL); if (!pcon)    eX(5);

    AryAssert(pcon, sz, 4, 1, nx, 1, ny, k1, k2, 0, nc-1);              eG(6);

    }

  else {

    pcon = TmnCreate(icon, sz, 4, 1, nx, 1, ny, k1, k2, 0, nc-1);       eG(7);

    }

  scatter = (sz == 2*sizeof(float));

  ng = MI.numgrp;

  rgf = (ng > 1) ? 1.0/(ng-1.0) : 1.0;

  area = dd*dd*(t2 - t1);

  for (i=1; i<=nx; i++)

    for (j=1; j<=ny; j++) {

      scale = 1;                                        //-98-08-22

      for (k=k1; k<=k2; k++) {

        if (k <= 0)  f = area;

        else {

          if (pvol) {

            pv = AryPtr(pvol, i, j, k);  if (!pv)       eX(31);

            f = (t2 - t1)*(*pv);

            }

          else  f = area*(sk[k] - sk[k-1])*scale;

          }

        pd = AryPtr(pdos, i, j, k, 0);  if (!pd)        eX(10);

        pc = AryPtr(pcon, i, j, k, 0);  if (!pc)        eX(11);

        for (l=0; l
          if (scatter) {

            dos = *pd++;

            if (dos <= 0.0) {

              *pc++ = 0.0;

              *pc++ = 0.0;

              pd++;                             /*-05feb96-*/

              }

            else {

              dsq = *pd++;

              *pc++ = dos/f;

              dev = (ng*dsq/(dos*dos)-1.0)*rgf;

              *pc++ = (dev < 0) ? 0.0 : sqrt(dev);

              }

            }

          else  *pc++ = (*pd++)/f;

          }  /* for l */

        }

      }

  TmnDetach(igrd, NULL, NULL, 0, NULL);                 eG(13);

  TmnDetach(idos, NULL, NULL, 0, NULL);                 eG(14);

  if (!invalid)  invalid = TMN_SETVALID;                        //-2001-06-29

  TmnDetach(icon, &t1, &t2, TMN_MODIFY|invalid, NULL);  eG(15);

  if (pvol) {

    TmnDetach(ivol, NULL, NULL, 0, NULL);               eG(32);

  }

  return 0;

eX_1:

  eMSG(_cant_get_grid_$_, NmsName(igrd));

eX_2:

  eMSG(_dose_$_undefined_, name);

eX_20:

  eMSG(_dose_$$$_not_suited_$_, name, t1s, t2s, TmString(&T1));

eX_3:

  eMSG(_cant_get_dose_$$$_, name, t1s, t2s);

eX_5:

  eMSG(_cant_get_concentration_$_, NmsName(icon));

eX_6:

  eMSG(_improper_structure_$_, NmsName(icon));

eX_7:

  eMSG(_cant_create_$_, NmsName(icon));

eX_10: eX_11: eX_31:

  eMSG(_index_error_$$$_, i, j, k);

eX_13: eX_14: eX_15:

  eMSG(_cant_detach_);

eX_30: eX_32:

  eMSG(_cant_get_grid_$_, NmsName(ivol));

  }



//-------------------------------------------------------------------- DtbMntSet

long DtbMntSet(long t1, int nc) 

{

  dP(DtbMntSet);

  int i, l, sz;

  long imon, imnt, ict;

  ARYDSC *pmnt, *pmon, *pct;

  MONREC *pm, *pn;

  CMPREC *pcmp;

  if (!(MI.flags & FLG_MNT) || NumMon < 1) return 0;

  sz = sizeof(MONREC);

  imnt = IDENT(MNTarr,0,0,0);

  imon = IDENT(MONarr,0,0,0);

    pmnt = TmnCreate(imnt, sz, 2, 1, NumMon, 0, nc-1);                 eG(1);

    pmon = TmnAttach(imon, NULL, NULL, 0, NULL);                       eG(2);

  ict = IDENT(CMPtab, 0, 0, 0);

    pct = TmnAttach(ict, NULL, NULL, 0, NULL);  if (!pct)              eX(3);

    pcmp = pct->start;

    for (i=1; i<=NumMon; i++) {

      pm = AryPtr(pmon, i);  if (!pm)                                  eX(4);

      for (l=0; l
        pn = AryPtr(pmnt, i, l); if (!pn)                              eX(5);

        AryCreate(&pn->arr, sizeof(float), 1, 0, MNT_NUMVAL);          eG(6);

            sprintf(pn->np, "%s", pm->np);

            pn->i = pm->i;   pn->j = pm->j;   pn->k = pm->k;

            pn->xp = pm->xp; pn->yp = pm->yp; pn->zp = pm->zp;

            pn->nn = pm->nn; pn->nl = pm->nl; pn->ni = pm->ni;

            pn->ic = l;

            pn->t1 = t1;

            pn->t2 = t1;

            pn->index = 0;

      }

    }

    TmnDetach(imon, NULL, NULL, 0, NULL);                              eG(7);

    TmnDetach(imnt, NULL, NULL, TMN_MODIFY, NULL);                     eG(8);

  return 0;

eX_1: eX_2: eX_3: eX_4: eX_5: eX_6: eX_7: eX_8:

  eMSG(_cant_attach_detach_);

}



//------------------------------------------------------------------ DtbMntRead

long DtbMntRead( void ) 

{

  dP(DtbMntRead);

  int i, n, l, nc, sz, m;

  char *_sp, name[512];

  float *fpi, *fpo;

  long imnt, ict, imon, t1, t2;

  ARYDSC *pmnt, *pmon, dsc, *pct;

  MONREC *pn, *pm;

  CMPREC *pcmp;

  TXTSTR usrhdr = { NULL, 0 };

  TXTSTR syshdr = { NULL, 0 };

  if (!(MI.flags & FLG_MNT) || NumMon < 1) return 0;

  memset(&dsc, 0, sizeof(dsc));                                     //-2002-10-28

  ict = IDENT(CMPtab,0,0,0);

  imnt = IDENT(MNTarr,0,0,0);

  imon = IDENT(MONarr,0,0,0);

  sz = sizeof(MONREC);

  if (NumMon > MNT_MAX-1)                                           eX(30); //-2002-10-28

  pct = TmnAttach(ict, NULL, NULL, 0, NULL);  if (!pct)             eX(1);

  pcmp = pct->start;

  nc = pct->bound[0].hgh-pct->bound[0].low+1;

  pmnt = TmnCreate(imnt, sz, 2, 1, NumMon, 0, nc-1);                eG(2);

  pmon = TmnAttach(imon, NULL, NULL, 0, NULL);                      eG(3);

  for (m=1; m<=NumMon; m++) {

    sprintf(name, "%s/mnt%04d", StdPath, m);

    if (0>DmnRead(name, &usrhdr, &syshdr, (ARYDSC *)&dsc))          eX(11);

    if (dsc.numdm != 2)                                             eX(21);

    n = dsc.bound[0].hgh-dsc.bound[0].low+1;

    if (dsc.bound[1].low != 0 || dsc.bound[1].hgh!=nc-1)            eX(21);

    if (1 != DmnGetString(usrhdr.s, "t1", &_sp, 1))                 eX(22);

    t1 = TmValue(_sp);

    FREE(_sp);                                                      //-2006-02-15

    if (1 != DmnGetString(usrhdr.s, "t2", &_sp, 1))                 eX(23);

    t2 = TmValue(_sp);

    FREE(_sp);                                                      //-2006-02-15

    if (n != (int)((t2-t1)/MI.cycle) || t2 != MI.dost1)             eX(24);

    if (dsc.elmsz != sizeof(float))                                 eX(25);

    pm = AryPtr(pmon, m); if (!pm)                                  eX(5);

    DmnRplValues(&usrhdr, "t1", NULL);

    DmnRplValues(&usrhdr, "t2", NULL);

    for (l=0; l
      pn = AryPtr(pmnt, m, l); if (!pn)                             eX(6);

      AryCreate(&pn->arr, sizeof(float), 1, 0, MNT_NUMVAL);         eG(7);

      sprintf(pn->np, "%s", pm->np);

      pn->i = pm->i;   pn->j = pm->j;   pn->k = pm->k;

      pn->xp = pm->xp; pn->yp = pm->yp; pn->zp = pm->zp;

      pn->nn = pm->nn; pn->nl = pm->nl; pn->ni = pm->ni;

      pn->ic = l;

      pn->t1 = t1;

      pn->t2 = t2;

      pn->index = n;

        for (i=0; i
        fpi = (float *)AryPtrX(&dsc, i, l);

        fpo = (float *)AryPtrX(&pn->arr, i);

        *fpo = *fpi;

      }

    }

    AryFree(&dsc);                                                  //-2002-10-28

  }

  TmnDetach(imnt, NULL, NULL, TMN_MODIFY, NULL);                     eG(8);

  TmnDetach(imon, NULL, NULL, 0, NULL);                              eG(8);

  TmnDetach(ict, NULL, NULL, 0, NULL);                               eG(8);

  return 0;

eX_30:

  eMSG(_count_monitor_$_, MNT_MAX);

eX_1: eX_2: eX_3: eX_5:  eX_6:  eX_7: eX_8:

  eMSG(_cant_get_tables_);

eX_11:

  eMSG(_cant_read_monitor_$_, name);

eX_21: eX_25:

  eMSG(_data_$_inconsistent_, name);

eX_22: eX_23: eX_24:

  eMSG(_wrong_times_$_, name);

}



#define IFCAT(a,b)   \

{char *c; c=ALLOC(strlen(a)+strlen(b)+1); strcpy(c,a); strcat(c,b); FREE(a); a=c;}

//------------------------------------------------------------------ DtbMntStore

long DtbMntStore( void ) 

{

  dP(DtbMntStore);

  int i, l, m, nc, i1, i2;

  char s[512], t1s[40], t2s[40];

  char *hdr, *name, *unit, *refc;                                   //-2001-09-07

  long imnt, ict, t1, t2;

  char *fp;

  ARYDSC *pmnt, *pct, dsc;

  MONREC *pn;

  CMPREC *pcmp;

  if (!(MI.flags & FLG_MNT) || NumMon < 1) return 0;

  ict = IDENT(CMPtab, 0, 0, 0);

  pct = TmnAttach(ict, NULL, NULL, 0, NULL);  if (!pct)              eX(1);

  pcmp = pct->start;

  imnt = IDENT(MNTarr,0,0,0);

  pmnt = TmnAttach(imnt, NULL, NULL, 0, NULL); if (!pmnt)            eX(2);

  nc = pmnt->bound[1].hgh-pmnt->bound[1].low + 1;

  if (nc != pct->bound[0].hgh-pct->bound[0].low+1)                   eX(3);



  // Header und Daten-Array erzeugen

  hdr  = ALLOC(GENHDRLEN);  if (!hdr)                               eX(11); //-2001-09-07

  name = ALLOC(GENHDRLEN);  if (!name)                              eX(12);

  unit = ALLOC(GENHDRLEN);  if (!unit)                              eX(13);

  refc = ALLOC(GENHDRLEN);  if (!refc)                              eX(14);

  for (m=1; m<=NumMon; m++) {

    pn = AryPtr(pmnt, m, 0); if (!pn)                                eX(4);

    pn->arr.bound[0].hgh = pn->arr.bound[0].low+pn->index-1;

    if (m == 1) {

      t1 = pn->t1;

      t2 = pn->t2;

      strcpy(t1s, TmString(&t1));

      strcpy(t2s, TmString(&t2));

      i1 = pn->arr.bound[0].low;

      i2 = pn->arr.bound[0].hgh;

    }

    memset(&dsc, 0, sizeof(ARYDSC));

    AryCreate(&dsc, sizeof(float), 2, i1, i2, 0, nc-1);              eG(5);

    if (pn->t1 != t1 || pn->t2 != t2)                                eX(7);

    if (pn->arr.bound[0].low != i1 || pn->arr.bound[0].hgh != i2)    eX(8);

    sprintf(hdr, "pgm\tTALDTB_%d.%d.%s\nkennung\t\"%s\"\n",

      StdVersion, StdRelease, StdPatch, MI.label);

    *hdr = 0;

    sprintf(s, "gakrx\t%d\n", GrdPprm->gakrx);             IFCAT(hdr, s);  //-2001-09-04

    sprintf(s, "gakry\t%d\n", GrdPprm->gakry);             IFCAT(hdr, s);

    sprintf(s, "mntn\t%10s\n", TxtQuote(pn->np));          IFCAT(hdr, s);

    sprintf(s, "mntx\t%10.1f\n", pn->xp);                  IFCAT(hdr, s);

    sprintf(s, "mnty\t%10.1f\n", pn->yp);                  IFCAT(hdr, s);

    sprintf(s, "mntz\t%10.1f\n", pn->zp);                  IFCAT(hdr, s);

    sprintf(s, "mnti\t%10d\n",   pn->i);                   IFCAT(hdr, s);

    sprintf(s, "mntj\t%10d\n",   pn->j);                   IFCAT(hdr, s);

    sprintf(s, "mntk\t%10d\n",   pn->k);                   IFCAT(hdr, s);

    sprintf(s, "grdl\t%10d\n",   pn->nl);                  IFCAT(hdr, s);

    sprintf(s, "grdi\t%10d\n",   pn->ni);                  IFCAT(hdr, s);

    sprintf(s, "undf\t-1\n");                              IFCAT(hdr, s);

    sprintf(s, "form\t\"%%12.4e\"\n");                     IFCAT(hdr, s);   //-2002-08-12

    sprintf(s, "t1\t\"%s\"\nt2\t\"%s\"\n", t1s, t2s);      IFCAT(hdr, s);   //-2002-07-04

    sprintf(s, "interval\t\"%s\"\n", TmString(&MI.cycle)); IFCAT(hdr, s);

    sprintf(s, "refdate\t\"%s\"\n", MI.refdate);           IFCAT(hdr, s);

    sprintf(s, "mode\t\"text\"\n");                        IFCAT(hdr, s);

    sprintf(s, "axes\t\"ts\"\n");                          IFCAT(hdr, s);

    sprintf(name, "name   ");

    sprintf(unit, "einheit");

    sprintf(refc, "refc   ");

    for (l=0; l
      sprintf(s, "\t%20s", TxtQuote(pcmp[l].name));   IFCAT(name, s);

      sprintf(s, "\t%20s", TxtQuote(pcmp[l].unit));   IFCAT(unit, s);

      sprintf(s, "\t%20.3e", pcmp[l].refc);           IFCAT(refc, s);

    }

    IFCAT(name, "\n"); IFCAT(hdr, name);

    IFCAT(unit, "\n"); IFCAT(hdr, unit);

    IFCAT(refc, "\n"); IFCAT(hdr, refc);

    for (i=i1; i<=i2; i++) {

      for (l=0; l
        fp = AryPtrX(&dsc, i, l);

        pn = AryPtr(pmnt, m, l); if (!pn)                               eX(9);

        *(float *)fp = *(float *)AryPtrX(&pn->arr, i);

      }

    }

    sprintf(s, "%s/mnt%04d", StdPath, m);

    if (0 > DmnWrite(s, hdr, &dsc))                                     eX(10);

    AryFree(&dsc);

    //

    for (l=0; l
      pn = AryPtr(pmnt, m, l); if (!pn)                              eX(9);

      AryFree(&pn->arr);                                             eG(23);

    }

  }

  FREE(hdr);

  FREE(name);

  FREE(unit);

  FREE(refc);

  //                                                              //-2006-02-15

  TmnDetach(imnt, NULL, NULL, 0, NULL);                             eG(20);

  TmnClear(TmMax(), imnt, TMN_NOID);                                eG(21);

  TmnDetach(ict, NULL, NULL, 0, NULL);                              eG(22);

  return 0;

eX_1: eX_2: eX_3: eX_4: eX_5: eX_7: eX_8: eX_9: eX_10:

eX_11: eX_12: eX_13: eX_14:

eX_20: eX_21: eX_22: eX_23:

  eMSG(_cant_write_);

}

#undef  IFCAT



/*================================================================ DtbRegister

*/

static void regval( float a, float g, DTBREC *p )

  {

  int i, n, m;

  float g0;

  if (a <= 0.0)  {

    p->frqnull += g;

    return; 

  }

  if (a >= DTB_RANGE*p->valmax) {

    g0 = 0.0;

    for (i=0; i
      g0 += p->frq[i];

      p->frq[i] = 0.0; }

    p->frqsub += g0;

    n = floor(1 + DTB_DIVISION*log10(a));

    p->valmax = pow(10.0, ((float)n)/DTB_DIVISION);

    p->frq[DTB_NUMVAL-1] = g;

    return;

  }

  n = floor(DTB_NUMVAL + DTB_DIVISION*log10(a/p->valmax));

  if (n < 0)  {

    p->frqsub += g;

    return; 

  }

  if (n < DTB_NUMVAL) {

    p->frq[n] += g;

    return; 

  }

  m = n - DTB_NUMVAL + 1;

  g0 = 0.0;

  for (i=0; ifrq[i];

  p->frqsub += g0;

  for ( ; i
    p->frq[i-m] = p->frq[i];

    p->frq[i] = 0.0; 

  }

  p->valmax *= pow(10.0, m/DTB_DIVISION);

  p->frq[DTB_NUMVAL-1] = g;

  return;

}



static void regmax(float a, float dev, DTBMAXREC *p) {

  int i, j;

  for (i=DTB_NUMMAX-1,j=-1; i>=0; i--)

    if (a > p->max[i]) j = i;

    else  break;                                                  //-2001-10-19

  if (j < 0) return;

  for (i=DTB_NUMMAX-1; i>j; i--) {

    p->max[i] = p->max[i-1];

    p->dev[i] = p->dev[i-1];

  }

  p->max[j] = a;

  p->dev[j] = dev;

}



//------------------------------------------------------------------ DtbRegister

long DtbRegister(       /* register in concentration distribution */

long idtb )

  {

  dP(DtbRegister);

  int gp, gl, gi, i, j, k, l, nx, ny, nz, nc, sz;

  char t1s[40], t2s[40], m1s[40], m2s[40], name[256], *hdr;	//-2004-11-26

  long t1, t2, m1, m2, rc, icon, idos, iblp, usage, imnt, invalid;  //-2006-02-15

  ARYDSC *pcon, *pdtb, *pblp, *pmnt;                                //-2006-02-15

  DTBREC  *pd;

  DTBMAXREC *pd2;

  MONREC  *pn;

  BLMPARM *pbp;                                                     //-2006-02-15

  float *pc, sg, a, dev, *pf;

  int scatter=0;

  strcpy(name, NmsName(idtb));

  vLOG(4)("concentration distribution %s", name);

  gp = (MI.average > 1);

  gl = XTR_LEVEL(idtb);

  gi = XTR_GRIDN(idtb);

  TmnInfo(idtb, &m1, &m2, &usage, NULL, NULL);

  if (!(usage & TMN_DEFINED))  m2 = TmMin();

  icon = IDENT(CONtab, gp, gl, gi);

  idos = IDENT(DOStab, gp, gl, gi);

  imnt = IDENT(MNTarr,0,0,0);

  TmnInfo(icon, &t1, &t2, &usage, NULL, NULL);

  if (usage & TMN_DEFINED) {

    if ((m2 > TmMin()) && (m2 != t1))                                eX(1);

  }

  else {

    icon = TmnIdent();

    DtbDos2Con(idos, icon, 1, 0);                                    eG(3);

    TmnInfo(icon, &t1, &t2, &usage, NULL, NULL);

    if (!(usage & TMN_DEFINED))                                      eX(4);

  }

  invalid = usage & TMN_INVALID;

  if (invalid) {                                                    //-2001-06-29

    if (PartNew) {

      PartDrop++;

      PartNew = 0;

    }

  }

  pcon = TmnAttach(icon, &t1, &t2, 0, NULL);  if (!pcon)             eX(5);

  nx = pcon->bound[0].hgh;

  ny = pcon->bound[1].hgh;

  nz = pcon->bound[2].hgh;

  nc = pcon->bound[3].hgh + 1;

  scatter = (pcon->elmsz == 2*sizeof(float));                       //-2001-10-19

  strcpy(t1s, TmString(&t1));

  strcpy(t2s, TmString(&t2));

  TmnInfo(idtb, &m1, &m2, &usage, NULL, NULL);

  if (usage & TMN_DEFINED) {

    if (m2 != t1)                                                    eX(6);

    pdtb = TmnAttach(idtb, &m1, &m2, TMN_MODIFY, NULL);  if (!pdtb)  eX(7);

  }

  else {

    sz = (MI.flags & FLG_MAXIMA) ? sizeof(DTBMAXREC) : sizeof(DTBREC);

    pdtb = TmnCreate(idtb, sz, 4, 1, nx, 1, ny, 1, nz, 0, nc-1);     eG(8);

    m1 = t1;

  }

  TmnInfo(imnt, NULL, NULL, &usage, NULL, NULL);

  if (!(usage & TMN_DEFINED)) {

      DtbMntSet(t1, nc);                                             eG(80);

  }

  //

  iblp = IDENT(BLMpar, 0, 0, 0);

  pblp =  TmnAttach(iblp, NULL, NULL, 0, NULL);  if (!pblp)          eX(11);

  pbp = (BLMPARM*) pblp->start;

  sg = pbp->StatWeight;

  TmnDetach(iblp, NULL, NULL, 0, NULL);                              eG(14);

  if (sg <= 0)                                                       eX(13);

  if ((MI.flags & FLG_MAXIMA) && sg != 1.)                           eX(20);

  if (invalid)  nx = 0;

  for (i=1; i<=nx; i++) {

    for (j=1; j<=ny; j++) {

      for (k=1; k<=nz; k++) {

        for (l=0; l
          pc = (float*) AryPtr(pcon, i, j, k, l);  if (!pc)          eX(15);

          a = pc[0]/sg;

          dev = (scatter) ? pc[1] : -1;                             //-2001-10-19

          if (MI.flags & FLG_MAXIMA) {

            pd2 = (DTBMAXREC*) AryPtr(pdtb, i, j, k, l);  if (!pd2)  eX(16);

            regmax(a, dev, pd2);

          }

          else {

            pd = (DTBREC*) AryPtr(pdtb, i, j, k, l);  if (!pd)       eX(16);

            if (a < 0.0)  continue;

            if (a == 0.0) {

              pd->frqnull += sg;

              continue;

            }

            if (a > pd->realmax) {                /*-04aug94-*/

              pd->realmax = a;

              pd->realdev = dev;

              pd->t1 = t1;

              pd->t2 = t2;

            }

            regval(a, sg, pd);

          }

        }

      }

    }

  }

  // get concentration at monitor points

  if (MI.flags & FLG_MNT) {

    pmnt = TmnAttach(imnt, NULL, NULL, TMN_MODIFY, NULL); if (!pmnt) eX(81);

    for (i=1; i<=NumMon; i++) {

      for (l=0; l
        pn = AryPtr(pmnt, i, l); if (!pn)                            eX(82);

        if (pn->nl != gl || pn->ni != gi) continue;

        if (t1 != pn->t2)                                            eX(83);

        pf = (float *)AryPtrX(&pn->arr, pn->index);

        if (invalid) {

          *pf++ = -1;

          *pf = 0;

        }

        else {

          pc = (float*) AryPtr(pcon, pn->i, pn->j, pn->k, l);  if (!pc) eX(84);

          if (pn->index >= MNT_NUMVAL)                                  eX(86); //-2003-12-05

          *pf++ = *pc++;

          *pf = *pc;

        }

        pn->index = pn->index+1;

        pn->t2 = t2;

      }

    }

    TmnDetach(imnt, NULL, NULL, TMN_MODIFY, NULL);                   eG(85);

  }



  TmnDetach(idtb, &m1, &t2, TMN_MODIFY, NULL);                       eG(17);

  TmnDetach(icon, NULL, NULL, 0, NULL);                              eG(18);

  if (icon & 0x80000000) { //bp

    TmnDelete(t2, icon, TMN_NOID);                                   eG(19);

  }

  return 0;

eX_1:  eX_6:

  strcpy(t1s, TmString(&t1));

  strcpy(t2s, TmString(&t2));

  strcpy(m1s, TmString(&m1));

  strcpy(m2s, TmString(&m2));

  strcpy(name, NmsName(icon));

  eMSG(_cant_add_$$$_$$$_, name, t1s, t2s, NmsName(idtb), m1s, m2s);

eX_3:  eX_4:  eX_5:

  strcpy(t1s, TmString(&t1));

  strcpy(t2s, TmString(&t2));

  strcpy(name, NmsName(icon));

  eMSG(_cant_get_$$$_, name, t1s, t2s);

eX_7:

  strcpy(m1s, TmString(&m1));

  strcpy(m2s, TmString(&m2));

  strcpy(name, NmsName(idtb));

  eMSG(_cant_get_$$$_, name, m1s, m2s);

eX_8:

  strcpy(name, NmsName(idtb));

  eMSG(_cant_create_$_, name);

eX_11: eX_14:

  eMSG(_cant_get_weight_);

eX_13:

  eMSG(_invalid_weight_$_, sg);

eX_15: eX_16:

  eMSG(_index_error_$$$$_, i, j, k, l);

eX_17: eX_18:

  eMSG(_cant_detach_);

eX_19:

  eMSG(_cant_clear_);

eX_20:

  eMSG(_cant_determine_maximum_);

eX_80: eX_81: eX_82: eX_83: eX_84: eX_85:

  eMSG(_cant_set_monitor_);

eX_86: 

  eMSG(_time_series_length_$_, MNT_NUMVAL);

}



/*================================================================== DtbHeader

*/

#define IFCAT(a,b)  if (strlen(a)+strlen(b) < GENHDRLEN)  strcat(a,b)



char *DtbHeader(                /* the header (global storage)  */

  long id,                      /* identification               */

  long *pt1,                    /* start of the validity time   */

  long *pt2 )                   /* end of validity time         */

  {

  dP(DtbHeader);

  char name[256], t1s[40], t2s[40], format[80], s[200];		//-2004-11-26

  int gl, gi, gp, iga, igp, k, ict, nz, nc, folge;

  char *atype;

  float *sk, valid;

  ARYDSC *pa, *pct, *pga;

  GRDPARM *pgp;

  CMPREC *pcmp;

  enum DATA_TYPE dt;

  strcpy(name, NmsName(id));

  dt = XTR_DTYPE(id);

  gp = XTR_GROUP(id);

  gl = XTR_LEVEL(id);

  gi = XTR_GRIDN(id);

  switch (dt) {

    case CONtab: atype = "C";

                 break;

    case DTBtab:

    case DTBarr: atype = (MI.flags & FLG_MAXIMA) ? "M" : "HN";

                 break;

    default:     atype = "?";

  }

  igp = IDENT(GRDpar, 0, gl, gi);

  pa =  TmnAttach(igp, NULL, NULL, 0, NULL);                    eG(1);

  if (!pa)                                                      eX(2);

  pgp = (GRDPARM*) pa->start;

  iga = IDENT(GRDarr, 0, 0, 0);

  pga =  TmnAttach(iga, NULL, NULL, 0, NULL);                   eG(3);

  if (!pga)                                                     eX(4);

  sk = (float*) pga->start;

  nz = pga->bound[0].hgh + 1;

  ict = IDENT(CMPtab, 0, 0, 0);

  pct = TmnAttach(ict, NULL, NULL, 0, NULL);                    eG(5);

  if (!pct)                                                     eX(6);

  pcmp = pct->start;

  nc = pct->bound[0].hgh + 1;

  strcpy(t1s, TmString(pt1));

  strcpy(t2s, TmString(pt2));

  sprintf(Hdr,

    " PGM=TALDTB_%d.%d.%s ARRTYPE=%s FILE=%s \n Kennung=\"%s\" T1=%s T2=%s \n",  //-2006-02-25

    StdVersion, StdRelease, StdPatch, atype, name, MI.label, t1s, t2s);

  folge = (MI.average>0 && gp==3) ? 1+(MI.cycind-1)/MI.average : MI.cycind;

  if (dt==DTBarr || dt==DTBtab) {

    if (MI.flags & FLG_MAXIMA)

      sprintf(s, " FORMAT=S00%%[10]10.2eS10%%[10]10.2eS20%%[%d]10.2e" "D00%%[10](*100)5.1fD10%%[10](*100)5.1fD20%%[%d](*100)5.1f \n DTBNUMMAX=%d %s",

        DTB_NUMMAX-20, DTB_NUMMAX-20, DTB_NUMMAX, " FOLGE=0 GRUPPEN=0 \n");

     else

      sprintf(s, 

        " FORMAT=Max%%10.2eN=%%[2]5.0fF0%%[10]3.0fFa%%[20]3.0fG0%%[%d]3.0f"

        "MaxVal%%10.2eMaxDev%%10.2eT1%%[2]13t \n DTBNUMVAL=%d FOLGE=0 GRUPPEN=0 \n",

         DTB_NUMVAL-30, DTB_NUMVAL);                            //-2005-03-17

  }

  else {

    strcpy(format, "Con%10.2e");

    if (MI.flags & FLG_SCAT)  strcat(format, "Dev%(*100)0.0f");

    sprintf(s, " FORMAT=%s \n FOLGE=%d  GRUPPEN=%d \n",

      format, folge, MI.numgrp);

  }

  IFCAT(Hdr, s);

  sprintf(s, " XMIN=%1.0f YMIN=%1.0f DELTA=%1.1f GAKRX=%d GAKRY=%d \n", //-2001-09-04

    pgp->xmin, pgp->ymin, pgp->dd, GrdPprm->gakrx, GrdPprm->gakry);

  IFCAT(Hdr, s);

  sprintf(s, " ZSCL=%1.0f SSCL=%1.0f SK= { \n", pgp->zscl, pgp->sscl);

  IFCAT(Hdr, s);

  for (k=0; k
    sprintf(s, " %1.1f", sk[k]);

    IFCAT(Hdr, s);

  }

  IFCAT(Hdr, " } \n");

  IFCAT(Hdr, " NAME = {");

  for (k=0; k
    sprintf(s, " %s", pcmp[k].name);

    IFCAT(Hdr, s);

  }

  IFCAT(Hdr, " } \n");

  IFCAT(Hdr, " EINHEIT = {");

  for (k=0; k
    sprintf(s, " %s", pcmp[k].unit);

    IFCAT(Hdr, s);

  }

  IFCAT(Hdr, " } \n");

  IFCAT(Hdr, " REFC = {");

  for (k=0; k
    sprintf(s, " %10.2e", pcmp[k].refc);

    IFCAT(Hdr, s);

  }

  IFCAT(Hdr, " } \n");

  IFCAT(Hdr, " REFD = {");

  for (k=0; k
    sprintf(s, " %10.2e", pcmp[k].refd);

    IFCAT(Hdr, s);

  }

  IFCAT(Hdr, " } \n");

  if (MI.flags & FLG_MAXIMA) {

    IFCAT(Hdr, " VALDEF = ");

    for (k=0; k
    IFCAT(Hdr, "\n");

  }

  TmnDetach(igp, NULL, NULL, 0, NULL);                  eG(10);

  TmnDetach(iga, NULL, NULL, 0, NULL);                  eG(11);

  TmnDetach(ict, NULL, NULL, 0, NULL);                  eG(12);

  valid = (PartTotal-PartDrop)/((float)PartTotal);

  IFCAT(Hdr, " Valid = ");                              //-2001-06-29

  sprintf(s, "%1.4f \n", valid);

  IFCAT(Hdr, s);

  return Hdr;

eX_1:  eX_2:  eX_3:  eX_4:  eX_5:  eX_6:

  nMSG(_cant_attach_);

  return NULL;

eX_10: eX_11: eX_12:

  nMSG(_cant_detach_);

  return NULL;

}

#undef  IFCAT



/*==================================================================== DtbInit

*/

long DtbInit(           /* initialize server    */

long flags,             /* action flags         */

char *istr )            /* server options       */

  {

  dP(DtbInit);

  long idtb, icon, imnt, mask;

  char *jstr, *ps, s[200];

  if (StdStatus & STD_INIT)  return 0;

  if (istr) {

    jstr = istr;

    ps = strstr(istr, "-v");

    if (ps) sscanf(ps+2, "%d", &StdLogLevel);

    ps = strstr(istr, "-y");

    if (ps) sscanf(ps+2, "%d", &StdDspLevel);

    ps = strstr(istr, "-d");

    if (ps)  strcpy(DefName, ps+2);

    }

  else  jstr = "";

  vLOG(3)("DTB_%d.%d.%s (%08lx,%s)", StdVersion, StdRelease, StdPatch, flags, jstr);

  StdStatus |= flags;

  mask = ~(NMS_GROUP|NMS_GRIDN|NMS_LEVEL);

  idtb = IDENT(DTBarr, 0, 0, 0);

  TmnCreator(idtb, mask, TMN_UNIQUE, "", DtbServer, DtbHeader);         eG(10);

  icon = IDENT(CONtab, 0, 0, 0);

  TmnCreator(icon, mask, TMN_UNIQUE, "", DtbServer, DtbHeader);         eG(1);



  if (MI.flags & FLG_MNT) {

    sprintf(s, " ZET -v%d -d%s", StdLogLevel, DefName);

    ZetInit(flags, s);

    imnt = IDENT(MNTarr, 0, 0, 0);

    TmnCreator(imnt, -1, TMN_UNIQUE, "", DtbServer, DtbHeader);         eG(8);

  }



  sprintf(s, " GRD -v%d -d%s", StdLogLevel, DefName);

  GrdInit(flags, s);                                                    eG(2);

  sprintf(s, " PRM -v%d -d%s", StdLogLevel, DefName);

  PrmInit(flags, s);                                                    eG(3);

  sprintf(s, " MOD -v%d -d%s", StdLogLevel, DefName);

  ModInit(flags, s);                                                    eG(4);

  sprintf(s, " DOS -v%d -d%s", StdLogLevel, DefName);

  DosInit(flags, s);                                                    eG(5);

  StdStatus |= STD_INIT;

  return 0;

eX_10:

  eMSG(_cant_set_creator_$_, NmsName(idtb));

eX_1:

  eMSG(_cant_set_creator_$_, NmsName(icon));

eX_2:  eX_3:  eX_4:  eX_5:

  eMSG(_cant_init_servers_);

eX_8:

  eMSG(_cant_read_monitor_);

}



  /*================================================================= DtbServer

  */

long DtbServer(         /* server routine for DTBarr, CONtab    */

  char *s )             /* calling option                       */

  {

  dP(DtbServer);

  char name[256];						//-2004-11-26

  int gl, gi, gp, net;

  long idos, idtb;

  enum DATA_TYPE dt;

  if (StdArg(s))  return 0;

  if (*s) {

    switch (s[1]) {

      case 'd': strcpy(DefName, s+2);

                break;

      case 'm': if (s[2] == 's')

                  DtbMntStore();

                else if (s[2] == 'r')

                  DtbMntRead();

                break;

      case 'n': if (s[2]) {                                      //-2001-06-29

                  sscanf(s+2, "%d,%d", &PartTotal, &PartDrop);

                  PartNew = 0;

                }

                else {

                  PartTotal++;

                  PartNew = 1;

                }

                break;

      default:  ;

      }

    return 0;

    }

  if (!StdIdent)                                                eX(10);

  if ((StdStatus & STD_INIT) == 0) {

    DtbInit(0, "");                                             eG(1);

    }

  dt = XTR_DTYPE(StdIdent);

  gl = XTR_LEVEL(StdIdent);

  gi = XTR_GRIDN(StdIdent);

  gp = XTR_GROUP(StdIdent);

  strcpy(name, NmsName(StdIdent));

  if (StdStatus & STD_TIME)  T1 = StdTime;

  else  T1 = TmMin();

  net = GrdPprm->numnet;

  do {

    if (net > 0) {

      GrdSetNet(net);                                           eG(5);

      }

    if ((gl) && (GrdPprm->level!=gl || GrdPprm->index != gi)) {

      net--;

      continue;

      }

    switch (dt) {

      case CONtab: idos = IDENT(DOStab, gp, GrdPprm->level, GrdPprm->index);

                   DtbDos2Con(idos, 0, 0, 0);                   eG(2);

                   break;

      case DTBarr: idtb = IDENT(DTBarr,  0, GrdPprm->level, GrdPprm->index);

                   DtbRegister(idtb);                           eG(3);

                   break;

      default:                                                  eX(4);

      }

    net--;

    }  while (net > 0);

  return 0;

eX_10:

  eMSG(_no_data_);

eX_1:

  eMSG(_cant_init_);

eX_2:

  strcpy(name, NmsName(idos));

  eMSG(_cant_calculate_contab_$_, name);

eX_3:

  strcpy(name, NmsName(idtb));

  eMSG(_cant_calculate_$_, name);

eX_4:

  eMSG(_invalid_request_$_, name);

eX_5:

  eMSG(_cant_set_grid_$_, net);

  }



//==============================================================================

//

// history:

// 

// 2002-09-24 lj 1.0.0  final release candidate

// 2002-10-28 lj 1.0.1  DtbMntRead() corrected (undefined array descriptor)

// 2003-12-05 lj 1.1.13 DtbRegister(): error message more specific

// 2004-11-26 lj 2.1.7  string length for names = 256     

// 2005-03-17 uj 2.1.8  4 decades

// 2005-03-17 uj 2.2.0  version number upgrade

// 2006-02-15 lj 2.2.9  get SG from BLMpar, clear arrays in MNTarr

//                      DtbMntRead corrected, freeing of strings

// 2006-02-25 uj        Kennung in quotation marks

// 2006-10-26 lj 2.3.0  external strings

//

//==============================================================================