https://github.com/cran/RandomFields
Raw File
Tip revision: f19c5f1146d16fe5a87883e4d7cc55abcc445d0f authored by Martin Schlather on 05 September 2005, 00:00:00 UTC
version 1.3.3
Tip revision: f19c5f1
RFspectral.cc
/*
 Authors
 Martin Schlather, schlath@hsu-hh.de

 Simulation of a random field by spectral turning bands

 Copyright (C) 2000 -- 2005 Martin Schlather, 

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., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
*/

#include <math.h>  
#include <stdio.h>  
#include <stdlib.h>
#include "RFsimu.h"
#include "RFCovFcts.h"
#include <assert.h>


int SPECTRAL_LINES=500; 
bool SPECTRAL_GRID=true;

void SetParamSpectral(int *action,int *nLines, int *grid) {
  if (*action) {
    SPECTRAL_LINES=*nLines; 
    SPECTRAL_GRID=(bool) *grid;
  } else {
    *nLines=SPECTRAL_LINES; 
    *grid= (int) SPECTRAL_GRID;
  }
}

void spectral_destruct(void **S) 
{ 
  if (*S!=NULL) {
      // spectral_storage *x; x =  *((spectral_storage**)S);
    free(*S);   
    *S = NULL;
  }
}

int init_simulatespectral(key_type *key, int m) {
  methodvalue_type *meth;  
  covinfo_type *keycov;
  spectral_storage *s;
  int Xerror, v, actcov;
  double store_variance=-1.0;

  meth = &(key->meth[m]);
  SET_DESTRUCT(spectral_destruct, m);
  if ((meth->S=malloc(sizeof(spectral_storage)))==0){
    Xerror=ERRORMEMORYALLOCATION; goto ErrorHandling;
  }
  s = (spectral_storage*)meth->S;
  if (key->Time) {Xerror=ERRORTIMENOTALLOWED; goto ErrorHandling;}

  // noerror_repeat = key->anisotropy;
  actcov=0;
  Xerror = NOERROR;
  for (v=0; v<key->ncov; v++) {
    keycov = &(key->cov[v]);
    if ((keycov->method==SpectralTBM) && (keycov->left)) {
      cov_fct *cov;
      int timespacedim;
      timespacedim = keycov->truetimespacedim;
      if (timespacedim == 0) {Xerror=ERRORTRIVIAL; goto ErrorHandling;}
      if (timespacedim > 2) {Xerror=ERRORWRONGDIM; goto ErrorHandling;}
      assert((keycov->nr >= 0) && (keycov->nr < currentNrCov));
      assert(keycov->param[VARIANCE] >= 0.0);
      meth->covlist[actcov] = v;
      cov = &(CovList[keycov->nr]);
      if (cov->type==ISOHYPERMODEL) {
	  Xerror=ERRORHYPERNOTALLOWED; 
	  goto ErrorHandling;
      }
      if (cov->implemented[SpectralTBM] != IMPLEMENTED) {
        Xerror=ERRORNOTDEFINED; goto ErrorHandling;}
      else s->randomAmplitude[actcov] = cov->spectral;
      if ((Xerror=cov->check(keycov->param, timespacedim, SpectralTBM))!=NOERROR)
	  goto ErrorHandling;
      if (actcov>0) {
        if (key->cov[v-1].op) {
          if (key->cov[v-1].method != SpectralTBM){
            if (GENERAL_PRINTLEVEL>0) 
	      PRINTF("severe error - contact author. %d %d %d %d(%s) %d(%s)\n",
		     v, key->cov[v-1].op, key->ncov, key->cov[v-1].method,
		     METHODNAMES[key->cov[v-1].method],
		     SpectralTBM, METHODNAMES[SpectralTBM]);
	    Xerror=ERRORMETHODMIX; goto ErrorHandling;
	    }
	  Xerror=ERRORNOMULTIPLICATION; goto ErrorHandling;
	}
	if (store_variance == keycov->param[VARIANCE]) actcov++;
	else {
	  keycov->left=true;
	  continue;
	}
      } else {
	store_variance = keycov->param[VARIANCE];
	// noerror_repeat= true; // only for !key->anisotropy ??
	actcov++;
      }
      if ((Xerror=Transform2NoGrid(key, v)) != NOERROR) 
	goto ErrorHandling;
      keycov->left = false;
    }
  } // for v
  meth->actcov=actcov;

  if (actcov==0) { /* no covariance for the considered method found */
    if (Xerror==NOERROR) Xerror=NOERROR_ENDOFLIST;
    goto ErrorHandling;
  }

  // if (noerror_repeat) return NOERROR_REPEAT;
  // else return Xerror;
  return NOERROR_REPEAT;

 ErrorHandling:
  return Xerror;
}

void do_simulatespectral(key_type *key, int m, double *res ) 
  // in two dimensions only!
{  
  methodvalue_type *meth; 
  int k, nx, ny, v;
  double phi=RF_INF, phistep=RF_INF, sqrttwodivbyn; //initialisation not use
  spectral_storage *s;
  covinfo_type *kc;

  meth = &(key->meth[m]);
  assert(key->active);
  s = (spectral_storage*) meth->S;

  for (v=0; v<meth->actcov; v++) {
    kc = &(key->cov[meth->covlist[v]]);
    assert((kc->truetimespacedim>=1) && (kc->truetimespacedim<=2));
  }

  kc = &(key->cov[meth->covlist[0]]);
  sqrttwodivbyn = sqrt(kc->param[VARIANCE] * 2.0 / (double) SPECTRAL_LINES);
  
  /* are the angles of the lines situated on a grid or random?
     if grid, then the step of the angle is 2\pi / SPECTRAL_LINES.
  */
  if (SPECTRAL_GRID) {
    phistep=TWOPI/ (double) SPECTRAL_LINES; 
    phi=phistep*UNIFORM_RANDOM;
  }
  v = (int) (UNIFORM_RANDOM * (double) meth->actcov);
  for (k=0; k<key->totalpoints; k++) { res[k]=0.0; }
  //the very procedure:
  for (k=0; k<SPECTRAL_LINES; k++) {
    double cp, Amp, VV;
    if (SPECTRAL_GRID) {phi+=phistep;} else {phi=TWOPI*UNIFORM_RANDOM;}  
    v = (v + 1) % meth->actcov;
    kc = &(key->cov[meth->covlist[v]]);
    VV = TWOPI * UNIFORM_RANDOM;
    Amp= (s->randomAmplitude[v])(kc->param); 
    cp = Amp * cos(phi);
    if (kc->simugrid) {
      double incx, segx;
      int zaehler;            
      zaehler = 0; 
      incx = kc->x[XSTEPDIM1] * cp;
      if (key->timespacedim==1) {
	segx = VV + kc->x[XSTARTDIM1] * cp;
	for (nx=0; nx<key->length[0]; nx++) {
	  res[zaehler++] += cos(segx);	  
	  segx += incx;
	}
      } else { // key->timespacedim==2
	double incy, segy, sp;            
	sp = Amp * sin(phi); 
	segy = VV + kc->x[XSTARTDIM1] * cp + kc->x[XSTARTDIM2] * sp;
	incy = kc->x[XSTEPDIM2] * sp; 
	for (ny=0; ny<key->length[1]; ny++) {	
	  segx = segy;
	  for (nx=0; nx<key->length[0]; nx++) {
	    res[zaehler++] += cos(segx);	  
	    segx += incx;
	  }
	  segy += incy;
	}
      }
    } else { // no grid
      if (kc->truetimespacedim==1) {
	for (nx=0; nx<key->totalpoints; nx++) {	
	  res[nx] += cos(cp * kc->x[nx] + VV);
	}
      } else { // kc->truetimespacedim==2 
	int twonx;
	double sp;
	sp = Amp * sin(phi); 
	for (nx=0; nx<key->totalpoints; nx++) {	
	  twonx = nx * 2;
	  res[nx] += cos(cp * kc->x[twonx] + sp * kc->x[twonx+1] + VV);
	}
      }	      
    }
  } // for k<SPECTRAL_LINES
  for (nx=0; nx<key->totalpoints; nx++) { res[nx] = res[nx]*sqrttwodivbyn; }  
}
  








back to top