FMS  2024.03
Flexible Modeling System
mosaic_util.c
Go to the documentation of this file.
1 /***********************************************************************
2  * GNU Lesser General Public License
3  *
4  * This file is part of the GFDL Flexible Modeling System (FMS).
5  *
6  * FMS is free software: you can redistribute it and/or modify it under
7  * the terms of the GNU Lesser General Public License as published by
8  * the Free Software Foundation, either version 3 of the License, or (at
9  * your option) any later version.
10  *
11  * FMS is distributed in the hope that it will be useful, but WITHOUT
12  * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13  * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14  * for more details.
15  *
16  * You should have received a copy of the GNU Lesser General Public
17  * License along with FMS. If not, see <http://www.gnu.org/licenses/>.
18  **********************************************************************/
19 #include <stdlib.h>
20 #include <stdio.h>
21 #include <math.h>
22 #include <string.h>
23 #ifdef use_libMPI
24 #include <mpi.h>
25 #endif
26 #include "mosaic_util.h"
27 #include "constant.h"
28 
29 #define HPI (0.5*M_PI)
30 #define TPI (2.0*M_PI)
31 #define TOLORENCE (1.e-6)
32 #define EPSLN8 (1.e-8)
33 #define EPSLN10 (1.e-10)
34 #define EPSLN15 (1.e-15)
35 #define EPSLN30 (1.e-30)
36 
37 /** \file
38  * \ingroup mosaic
39  * \brief Error handling and other general utilities for @ref mosaic_mod
40  */
41 
42 /***********************************************************
43  void error_handler(char *str)
44  error handler: will print out error message and then abort
45 ***********************************************************/
46 
47 void error_handler(const char *msg)
48 {
49  fprintf(stderr, "FATAL Error: %s\n", msg );
50 #ifdef use_libMPI
51  MPI_Abort(MPI_COMM_WORLD, -1);
52 #else
53  exit(1);
54 #endif
55 } /* error_handler */
56 
57 /*********************************************************************
58 
59  int nearest_index(double value, const double *array, int ia)
60 
61  return index of nearest data point within "array" corresponding to "value".
62  if "value" is outside the domain of "array" then nearest_index = 0
63  or = size(array)-1 depending on whether array(0) or array(ia-1) is
64  closest to "value"
65 
66  Arguments:
67  value: arbitrary data...same units as elements in "array"
68  array: array of data points (must be monotonically increasing)
69  ia : size of array.
70 
71 ********************************************************************/
72 int nearest_index(double value, const double *array, int ia)
73 {
74  int index, i;
75  int keep_going;
76 
77  for(i=1; i<ia; i++){
78  if (array[i] < array[i-1])
79  error_handler("nearest_index: array must be monotonically increasing");
80  }
81  if (value < array[0] )
82  index = 0;
83  else if ( value > array[ia-1])
84  index = ia-1;
85  else
86  {
87  i=0;
88  keep_going = 1;
89  while (i < ia && keep_going) {
90  i = i+1;
91  if (value <= array[i]) {
92  index = i;
93  if (array[i]-value > value-array[i-1]) index = i-1;
94  keep_going = 0;
95  }
96  }
97  }
98  return index;
99 
100 }
101 
102 /******************************************************************/
103 
104 void tokenize(const char * const string, const char *tokens, unsigned int varlen,
105  unsigned int maxvar, char * pstring, unsigned int * const nstr)
106 {
107  size_t i, j, nvar, len, ntoken;
108  int found, n;
109 
110  nvar = 0; j = 0;
111  len = strlen(string);
112  ntoken = strlen(tokens);
113  /* here we use the fact that C array [][] is contiguous in memory */
114  if(string[0] == 0)error_handler("Error from tokenize: to-be-parsed string is empty");
115 
116  for(i = 0; i < len; i ++){
117  if(string[i] != ' ' && string[i] != '\t'){
118  found = 0;
119  for(n=0; n<ntoken; n++) {
120  if(string[i] == tokens[n] ) {
121  found = 1;
122  break;
123  }
124  }
125  if(found) {
126  if( j != 0) { /* remove :: */
127  *(pstring + (nvar++)*varlen + j) = 0;
128  j = 0;
129  if(nvar >= maxvar) error_handler("Error from tokenize: number of variables exceeds limit");
130  }
131  }
132  else {
133  *(pstring + nvar*varlen + j++) = string[i];
134  if(j >= varlen ) error_handler("error from tokenize: variable name length exceeds limit during tokenization");
135  }
136  }
137  }
138  *(pstring + nvar*varlen + j) = 0;
139 
140  *nstr = ++nvar;
141 
142 }
143 
144 /*******************************************************************************
145  double maxval_double(int size, double *data)
146  get the maximum value of double array
147 *******************************************************************************/
148 double maxval_double(int size, const double *data)
149 {
150  int n;
151  double maxval;
152 
153  maxval = data[0];
154  for(n=1; n<size; n++){
155  if( data[n] > maxval ) maxval = data[n];
156  }
157 
158  return maxval;
159 
160 } /* maxval_double */
161 
162 
163 /*******************************************************************************
164  double minval_double(int size, double *data)
165  get the minimum value of double array
166 *******************************************************************************/
167 double minval_double(int size, const double *data)
168 {
169  int n;
170  double minval;
171 
172  minval = data[0];
173  for(n=1; n<size; n++){
174  if( data[n] < minval ) minval = data[n];
175  }
176 
177  return minval;
178 
179 } /* minval_double */
180 
181 /*******************************************************************************
182  double avgval_double(int size, double *data)
183  get the average value of double array
184 *******************************************************************************/
185 double avgval_double(int size, const double *data)
186 {
187  int n;
188  double avgval;
189 
190  avgval = 0;
191  for(n=0; n<size; n++) avgval += data[n];
192  avgval /= size;
193 
194  return avgval;
195 
196 } /* avgval_double */
197 
198 
199 /*******************************************************************************
200  void latlon2xyz
201  Routine to map (lon, lat) to (x,y,z)
202 ******************************************************************************/
203 void latlon2xyz(int size, const double *lon, const double *lat, double *x, double *y, double *z)
204 {
205  int n;
206 
207  for(n=0; n<size; n++) {
208  x[n] = cos(lat[n])*cos(lon[n]);
209  y[n] = cos(lat[n])*sin(lon[n]);
210  z[n] = sin(lat[n]);
211  }
212 
213 } /* latlon2xyz */
214 
215 /*------------------------------------------------------------
216  void xyz2laton(np, p, xs, ys)
217  Transfer cartesian coordinates to spherical coordinates
218  ----------------------------------------------------------*/
219 void xyz2latlon( int np, const double *x, const double *y, const double *z, double *lon, double *lat)
220 {
221 
222  double xx, yy, zz;
223  double dist;
224  int i;
225 
226  for(i=0; i<np; i++) {
227  xx = x[i];
228  yy = y[i];
229  zz = z[i];
230  dist = sqrt(xx*xx+yy*yy+zz*zz);
231  xx /= dist;
232  yy /= dist;
233  zz /= dist;
234 
235  if ( fabs(xx)+fabs(yy) < EPSLN10 )
236  lon[i] = 0;
237  else
238  lon[i] = atan2(yy, xx);
239  lat[i] = asin(zz);
240 
241  if ( lon[i] < 0.) lon[i] = 2.*M_PI + lon[i];
242  }
243 
244 } /* xyz2latlon */
245 
246 /*------------------------------------------------------------------------------
247  double box_area(double ll_lon, double ll_lat, double ur_lon, double ur_lat)
248  return the area of a lat-lon grid box. grid is in radians.
249  ----------------------------------------------------------------------------*/
250 double box_area(double ll_lon, double ll_lat, double ur_lon, double ur_lat)
251 {
252  double dx = ur_lon-ll_lon;
253 
254  if(dx > M_PI) dx = dx - 2.0*M_PI;
255  if(dx < -M_PI) dx = dx + 2.0*M_PI;
256 
257  return (dx*(sin(ur_lat)-sin(ll_lat))*RADIUS*RADIUS ) ;
258 
259 } /* box_area */
260 
261 
262 /*------------------------------------------------------------------------------
263  double poly_area(const x[], const y[], int n)
264  obtains area of input polygon by line integrating -sin(lat)d(lon)
265  Vertex coordinates must be in degrees.
266  Vertices must be listed counter-clockwise around polygon.
267  grid is in radians.
268  ----------------------------------------------------------------------------*/
269 double poly_area_dimensionless(const double x[], const double y[], int n)
270 {
271  double area = 0.0;
272  int i;
273 
274  for (i=0;i<n;i++) {
275  int ip = (i+1) % n;
276  double dx = (x[ip]-x[i]);
277  double lat1, lat2;
278  double dy, dat;
279 
280  lat1 = y[ip];
281  lat2 = y[i];
282  if(dx > M_PI) dx = dx - 2.0*M_PI;
283  if(dx < -M_PI) dx = dx + 2.0*M_PI;
284  if (dx==0.0) continue;
285 
286  if ( fabs(lat1-lat2) < SMALL_VALUE) /* cheap area calculation along latitude */
287  area -= dx*sin(0.5*(lat1+lat2));
288  else {
289  dy = 0.5*(lat1-lat2);
290  dat = sin(dy)/dy;
291  area -= dx*sin(0.5*(lat1+lat2))*dat;
292  }
293  }
294  if(area < 0)
295  return (-area/(4*M_PI));
296  else
297  return (area/(4*M_PI));
298 
299 } /* poly_area */
300 
301 double poly_area(const double x[], const double y[], int n)
302 {
303  double area = 0.0;
304  int i;
305 
306  for (i=0;i<n;i++) {
307  int ip = (i+1) % n;
308  double dx = (x[ip]-x[i]);
309  double lat1, lat2;
310  double dy, dat;
311 
312  lat1 = y[ip];
313  lat2 = y[i];
314  if(dx > M_PI) dx = dx - 2.0*M_PI;
315  if(dx < -M_PI) dx = dx + 2.0*M_PI;
316  if (dx==0.0) continue;
317 
318  if ( fabs(lat1-lat2) < SMALL_VALUE) /* cheap area calculation along latitude */
319  area -= dx*sin(0.5*(lat1+lat2));
320  else {
321  dy = 0.5*(lat1-lat2);
322  dat = sin(dy)/dy;
323  area -= dx*sin(0.5*(lat1+lat2))*dat;
324  }
325  }
326  if(area < 0)
327  return -area*RADIUS*RADIUS;
328  else
329  return area*RADIUS*RADIUS;
330 
331 } /* poly_area */
332 
333 double poly_area_no_adjust(const double x[], const double y[], int n)
334 {
335  double area = 0.0;
336  int i;
337 
338  for (i=0;i<n;i++) {
339  int ip = (i+1) % n;
340  double dx = (x[ip]-x[i]);
341  double lat1, lat2;
342 
343  lat1 = y[ip];
344  lat2 = y[i];
345  if (dx==0.0) continue;
346 
347  if ( fabs(lat1-lat2) < SMALL_VALUE) /* cheap area calculation along latitude */
348  area -= dx*sin(0.5*(lat1+lat2));
349  else
350  area += dx*(cos(lat1)-cos(lat2))/(lat1-lat2);
351  }
352  if(area < 0)
353  return area*RADIUS*RADIUS;
354  else
355  return area*RADIUS*RADIUS;
356 } /* poly_area_no_adjust */
357 
358 int delete_vtx(double x[], double y[], int n, int n_del)
359 {
360  for (;n_del<n-1;n_del++) {
361  x[n_del] = x[n_del+1];
362  y[n_del] = y[n_del+1];
363  }
364 
365  return (n-1);
366 } /* delete_vtx */
367 
368 int insert_vtx(double x[], double y[], int n, int n_ins, double lon_in, double lat_in)
369 {
370  int i;
371 
372  for (i=n-1;i>=n_ins;i--) {
373  x[i+1] = x[i];
374  y[i+1] = y[i];
375  }
376 
377  x[n_ins] = lon_in;
378  y[n_ins] = lat_in;
379  return (n+1);
380 } /* insert_vtx */
381 
382 void v_print(double x[], double y[], int n)
383 {
384  int i;
385 
386  for (i=0;i<n;i++){
387  printf(" %20g %20g\n", x[i], y[i]);
388  }
389 } /* v_print */
390 
391 int fix_lon(double x[], double y[], int n, double tlon)
392 {
393  double x_sum, dx, dx_;
394  int i, nn = n, pole = 0;
395 
396  for (i=0;i<nn;i++) if (fabs(y[i])>=HPI-TOLORENCE) pole = 1;
397  if (0&&pole) {
398  printf("fixing pole cell\n");
399  v_print(x, y, nn);
400  printf("---------");
401  }
402 
403  /* all pole points must be paired */
404  for (i=0;i<nn;i++) if (fabs(y[i])>=HPI-TOLORENCE) {
405  int im=(i+nn-1)%nn, ip=(i+1)%nn;
406 
407  if (y[im]==y[i] && y[ip]==y[i]) {
408  nn = delete_vtx(x, y, nn, i);
409  i--;
410  } else if (y[im]!=y[i] && y[ip]!=y[i]) {
411  nn = insert_vtx(x, y, nn, i, x[i], y[i]);
412  i++;
413  }
414  }
415  /* first of pole pair has longitude of previous vertex */
416  /* second of pole pair has longitude of subsequent vertex */
417  for (i=0;i<nn;i++) if (fabs(y[i])>=HPI-TOLORENCE) {
418  int im=(i+nn-1)%nn, ip=(i+1)%nn;
419 
420  if (y[im]!=y[i]){
421  x[i] = x[im];
422  }
423  if (y[ip]!=y[i]){
424  x[i] = x[ip];
425  }
426  }
427 
428  if (nn){
429  x_sum = x[0];
430  }
431  else{
432  return(0);
433  }
434  for (i=1;i<nn;i++) {
435  dx_ = x[i]-x[i-1];
436 
437  if (dx_ < -M_PI) dx_ = dx_ + TPI;
438  else if (dx_ > M_PI) dx_ = dx_ - TPI;
439  x_sum += (x[i] = x[i-1] + dx_);
440  }
441 
442  dx = (x_sum/nn)-tlon;
443  if (dx < -M_PI){
444  for (i=0;i<nn;i++){
445  x[i] += TPI;
446  }
447  }
448  else if (dx > M_PI){
449  for (i=0;i<nn;i++){
450  x[i] -= TPI;
451  }
452  }
453 
454  if (0&&pole) {
455  printf("area=%g\n", poly_area(x, y,nn));
456  v_print(x, y, nn);
457  printf("---------");
458  }
459 
460  return (nn);
461 } /* fix_lon */
462 
463 
464 /*------------------------------------------------------------------------------
465  double great_circle_distance()
466  computes distance between two points along a great circle
467  (the shortest distance between 2 points on a sphere)
468  returned in units of meter
469  ----------------------------------------------------------------------------*/
470 double great_circle_distance(double *p1, double *p2)
471 {
472  double dist, beta;
473 
474  /* This algorithm is not accurate for small distance
475  dist = RADIUS*ACOS(SIN(p1[1])*SIN(p2[1]) + COS(p1[1])*COS(p2[1])*COS(p1[0]-p2[0]));
476  */
477  beta = 2.*asin( sqrt( sin((p1[1]-p2[1])/2.)*sin((p1[1]-p2[1])/2.) +
478  cos(p1[1])*cos(p2[1])*(sin((p1[0]-p2[0])/2.)*sin((p1[0]-p2[0])/2.)) ) );
479  dist = RADIUS*beta;
480  return dist;
481 
482 } /* great_circle_distance */
483 
484 
485 /* Compute the great circle area of a polygon on a sphere */
486 double great_circle_area(int n, const double *x, const double *y, const double *z) {
487  int i;
488  double pnt0[3], pnt1[3], pnt2[3];
489  double sum, area;
490 
491  /* sum angles around polygon */
492  sum=0.0;
493  for ( i=0; i<n; i++) {
494  /* points that make up a side of polygon */
495  pnt0[0] = x[i];
496  pnt0[1] = y[i];
497  pnt0[2] = z[i];
498  pnt1[0] = x[(i+1)%n];
499  pnt1[1] = y[(i+1)%n];
500  pnt1[2] = z[(i+1)%n];
501  pnt2[0] = x[(i+2)%n];
502  pnt2[1] = y[(i+2)%n];
503  pnt2[2] = z[(i+2)%n];
504 
505  /* compute angle for pnt1 */
506  sum += spherical_angle(pnt1, pnt2, pnt0);
507 
508  }
509  area = (sum - (n-2.)*M_PI) * RADIUS* RADIUS;
510  return area;
511 }
512 
513 /*------------------------------------------------------------------------------
514  double spherical_angle(const double *p1, const double *p2, const double *p3)
515  p3
516  /
517  /
518  p1 ---> angle
519  \
520  \
521  p2
522  -----------------------------------------------------------------------------*/
523 double spherical_angle(const double *v1, const double *v2, const double *v3)
524 {
525  double angle;
526  long double px, py, pz, qx, qy, qz, ddd;
527 
528  /* vector product between v1 and v2 */
529  px = v1[1]*v2[2] - v1[2]*v2[1];
530  py = v1[2]*v2[0] - v1[0]*v2[2];
531  pz = v1[0]*v2[1] - v1[1]*v2[0];
532  /* vector product between v1 and v3 */
533  qx = v1[1]*v3[2] - v1[2]*v3[1];
534  qy = v1[2]*v3[0] - v1[0]*v3[2];
535  qz = v1[0]*v3[1] - v1[1]*v3[0];
536 
537  ddd = (px*px+py*py+pz*pz)*(qx*qx+qy*qy+qz*qz);
538  if ( ddd <= 0.0 )
539  angle = 0. ;
540  else {
541  ddd = (px*qx+py*qy+pz*qz) / sqrtl(ddd);
542  if( fabsl(ddd-1) < EPSLN30 ) ddd = 1;
543  if( fabsl(ddd+1) < EPSLN30 ) ddd = -1;
544  if ( ddd>1. || ddd<-1. ) {
545  /*FIX (lmh) to correctly handle co-linear points (angle near pi or 0) */
546  if (ddd < 0.)
547  angle = M_PI;
548  else
549  angle = 0.;
550  }
551  else
552  angle = ((double)acosl( ddd ));
553  }
554 
555  return angle;
556 } /* spherical_angle */
557 
558 /*------------------------------------------------------------------------------
559  double spherical_excess_area(p_lL, p_uL, p_lR, p_uR)
560  get the surface area of a cell defined as a quadrilateral
561  on the sphere. Area is computed as the spherical excess
562  [area units are m^2]
563  ----------------------------------------------------------------------------*/
564 double spherical_excess_area(const double* p_ll, const double* p_ul,
565  const double* p_lr, const double* p_ur, double radius)
566 {
567  double area, ang1, ang2, ang3, ang4;
568  double v1[3], v2[3], v3[3];
569 
570  /* S-W: 1 */
571  latlon2xyz(1, p_ll, p_ll+1, v1, v1+1, v1+2);
572  latlon2xyz(1, p_lr, p_lr+1, v2, v2+1, v2+2);
573  latlon2xyz(1, p_ul, p_ul+1, v3, v3+1, v3+2);
574  ang1 = spherical_angle(v1, v2, v3);
575 
576  /* S-E: 2 */
577  latlon2xyz(1, p_lr, p_lr+1, v1, v1+1, v1+2);
578  latlon2xyz(1, p_ur, p_ur+1, v2, v2+1, v2+2);
579  latlon2xyz(1, p_ll, p_ll+1, v3, v3+1, v3+2);
580  ang2 = spherical_angle(v1, v2, v3);
581 
582  /* N-E: 3 */
583  latlon2xyz(1, p_ur, p_ur+1, v1, v1+1, v1+2);
584  latlon2xyz(1, p_ul, p_ul+1, v2, v2+1, v2+2);
585  latlon2xyz(1, p_lr, p_lr+1, v3, v3+1, v3+2);
586  ang3 = spherical_angle(v1, v2, v3);
587 
588  /* N-W: 4 */
589  latlon2xyz(1, p_ul, p_ul+1, v1, v1+1, v1+2);
590  latlon2xyz(1, p_ur, p_ur+1, v2, v2+1, v2+2);
591  latlon2xyz(1, p_ll, p_ll+1, v3, v3+1, v3+2);
592  ang4 = spherical_angle(v1, v2, v3);
593 
594  area = (ang1 + ang2 + ang3 + ang4 - 2.*M_PI) * radius* radius;
595 
596  return area;
597 
598 } /* spherical_excess_area */
599 
600 
601 /*----------------------------------------------------------------------
602  void vect_cross(e, p1, p2)
603  Perform cross products of 3D vectors: e = P1 X P2
604  -------------------------------------------------------------------*/
605 
606 void vect_cross(const double *p1, const double *p2, double *e )
607 {
608 
609  e[0] = p1[1]*p2[2] - p1[2]*p2[1];
610  e[1] = p1[2]*p2[0] - p1[0]*p2[2];
611  e[2] = p1[0]*p2[1] - p1[1]*p2[0];
612 
613 } /* vect_cross */
614 
615 
616 /*----------------------------------------------------------------------
617  double* vect_cross(p1, p2)
618  return cross products of 3D vectors: = P1 X P2
619  -------------------------------------------------------------------*/
620 
621 double dot(const double *p1, const double *p2)
622 {
623 
624  return( p1[0]*p2[0] + p1[1]*p2[1] + p1[2]*p2[2] );
625 
626 }
627 
628 
629 double metric(const double *p) {
630  return (sqrt(p[0]*p[0] + p[1]*p[1]+p[2]*p[2]) );
631 }
632 
633 
634 /* ----------------------------------------------------------------
635  make a unit vector
636  --------------------------------------------------------------*/
637 void normalize_vect(double *e)
638 {
639  double pdot;
640  int k;
641 
642  pdot = e[0]*e[0] + e[1] * e[1] + e[2] * e[2];
643  pdot = sqrt( pdot );
644 
645  for(k=0; k<3; k++) e[k] /= pdot;
646 }
647 
648 
649 /*------------------------------------------------------------------
650  void unit_vect_latlon(int size, lon, lat, vlon, vlat)
651 
652  calculate unit vector for latlon in cartesian coordinates
653 
654  ---------------------------------------------------------------------*/
655 void unit_vect_latlon(int size, const double *lon, const double *lat, double *vlon, double *vlat)
656 {
657  double sin_lon, cos_lon, sin_lat, cos_lat;
658  int n;
659 
660  for(n=0; n<size; n++) {
661  sin_lon = sin(lon[n]);
662  cos_lon = cos(lon[n]);
663  sin_lat = sin(lat[n]);
664  cos_lat = cos(lat[n]);
665 
666  vlon[3*n] = -sin_lon;
667  vlon[3*n+1] = cos_lon;
668  vlon[3*n+2] = 0.;
669 
670  vlat[3*n] = -sin_lat*cos_lon;
671  vlat[3*n+1] = -sin_lat*sin_lon;
672  vlat[3*n+2] = cos_lat;
673  }
674 } /* unit_vect_latlon */
675 
676 
677 /* Intersect a line and a plane
678  Intersects between the plane ( three points ) (entries in counterclockwise order)
679  and the line determined by the endpoints l1 and l2 (t=0.0 at l1 and t=1.0 at l2)
680  returns true if the two intersect and the output variables are valid
681  outputs p containing the coordinates in the tri and t the coordinate in the line
682  of the intersection.
683  NOTE: the intersection doesn't have to be inside the tri or line for this to return true
684 */
685 int intersect_tri_with_line(const double *plane, const double *l1, const double *l2, double *p,
686  double *t) {
687 
688  long double M[3*3], inv_M[3*3];
689  long double V[3];
690  long double X[3];
691  int is_invert=0;
692 
693  const double *pnt0=plane;
694  const double *pnt1=plane+3;
695  const double *pnt2=plane+6;
696 
697  /* To do intersection just solve the set of linear equations for both
698  Setup M
699  */
700  M[0]=l1[0]-l2[0]; M[1]=pnt1[0]-pnt0[0]; M[2]=pnt2[0]-pnt0[0];
701  M[3]=l1[1]-l2[1]; M[4]=pnt1[1]-pnt0[1]; M[5]=pnt2[1]-pnt0[1];
702  M[6]=l1[2]-l2[2]; M[7]=pnt1[2]-pnt0[2]; M[8]=pnt2[2]-pnt0[2];
703 
704 
705  /* Invert M */
706  is_invert = invert_matrix_3x3(M,inv_M);
707  if (!is_invert) return 0;
708 
709  /* Set variable holding vector */
710  V[0]=l1[0]-pnt0[0];
711  V[1]=l1[1]-pnt0[1];
712  V[2]=l1[2]-pnt0[2];
713 
714  /* Calculate solution */
715  mult(inv_M, V, X);
716 
717  /* Get answer out */
718  *t=((double)X[0]);
719  p[0]=((double)X[1]);
720  p[1]=((double)X[2]);
721 
722  return 1;
723 }
724 
725 
726 void mult(long double m[], long double v[], long double out_v[]) {
727 
728  out_v[0]=m[0]*v[0]+m[1]*v[1]+m[2]*v[2];
729  out_v[1]=m[3]*v[0]+m[4]*v[1]+m[5]*v[2];
730  out_v[2]=m[6]*v[0]+m[7]*v[1]+m[8]*v[2];
731 
732 }
733 
734 
735 /* returns 1 if matrix is inverted, 0 otherwise */
736 int invert_matrix_3x3(long double m[], long double m_inv[]) {
737 
738 
739  const long double det = m[0] * (m[4]*m[8] - m[5]*m[7])
740  -m[1] * (m[3]*m[8] - m[5]*m[6])
741  +m[2] * (m[3]*m[7] - m[4]*m[6]);
742 #ifdef test_invert_matrix_3x3
743  printf("det = %Lf\n", det);
744 #endif
745  if (fabsl(det) < EPSLN15 ) return 0;
746 
747  const long double deti = 1.0/det;
748 
749  m_inv[0] = (m[4]*m[8] - m[5]*m[7]) * deti;
750  m_inv[1] = (m[2]*m[7] - m[1]*m[8]) * deti;
751  m_inv[2] = (m[1]*m[5] - m[2]*m[4]) * deti;
752 
753  m_inv[3] = (m[5]*m[6] - m[3]*m[8]) * deti;
754  m_inv[4] = (m[0]*m[8] - m[2]*m[6]) * deti;
755  m_inv[5] = (m[2]*m[3] - m[0]*m[5]) * deti;
756 
757  m_inv[6] = (m[3]*m[7] - m[4]*m[6]) * deti;
758  m_inv[7] = (m[1]*m[6] - m[0]*m[7]) * deti;
759  m_inv[8] = (m[0]*m[4] - m[1]*m[3]) * deti;
760 
761  return 1;
762 }
763 
764 #ifndef MAXNODELIST
765 #define MAXNODELIST 100
766 #endif
767 
768 struct Node *nodeList=NULL;
769 int curListPos=0;
770 
771 void rewindList(void)
772 {
773  int n;
774 
775  curListPos = 0;
776  if(!nodeList) nodeList = (struct Node *)malloc(MAXNODELIST*sizeof(struct Node));
777  for(n=0; n<MAXNODELIST; n++) initNode(nodeList+n);
778 
779 }
780 
781 struct Node *getNext()
782 {
783  struct Node *temp=NULL;
784  int n;
785 
786  if(!nodeList) {
787  nodeList = (struct Node *)malloc(MAXNODELIST*sizeof(struct Node));
788  for(n=0; n<MAXNODELIST; n++) initNode(nodeList+n);
789  }
790 
791  temp = nodeList+curListPos;
792  curListPos++;
793  if(curListPos > MAXNODELIST) error_handler("getNext: curListPos >= MAXNODELIST");
794 
795  return (temp);
796 }
797 
798 
799 void initNode(struct Node *node)
800 {
801  node->x = 0;
802  node->y = 0;
803  node->z = 0;
804  node->u = 0;
805  node->intersect = 0;
806  node->inbound = 0;
807  node->isInside = 0;
808  node->Next = NULL;
809  node->initialized=0;
810 
811 }
812 
813 void addEnd(struct Node *list, double x, double y, double z, int intersect, double u, int inbound, int inside)
814 {
815 
816  struct Node *temp=NULL;
817 
818  if(list == NULL) error_handler("addEnd: list is NULL");
819 
820  if(list->initialized) {
821 
822  /* (x,y,z) might already in the list when intersect is true and u=0 or 1 */
823  temp = list;
824  while (temp) {
825  if(samePoint(temp->x, temp->y, temp->z, x, y, z)) return;
826  temp=temp->Next;
827  }
828  temp = list;
829  while(temp->Next)
830  temp=temp->Next;
831 
832  /* Append at the end of the list. */
833  temp->Next = getNext();
834  temp = temp->Next;
835  }
836  else {
837  temp = list;
838  }
839 
840  temp->x = x;
841  temp->y = y;
842  temp->z = z;
843  temp->u = u;
844  temp->intersect = intersect;
845  temp->inbound = inbound;
846  temp->initialized=1;
847  temp->isInside = inside;
848 }
849 
850 /* return 1 if the point (x,y,z) is added in the list, return 0 if it is already in the list */
851 
852 int addIntersect(struct Node *list, double x, double y, double z, int intersect, double u1, double u2, int inbound,
853  int is1, int ie1, int is2, int ie2)
854 {
855 
856  double u1_cur, u2_cur;
857  int i1_cur, i2_cur;
858  struct Node *temp=NULL;
859 
860  if(list == NULL) error_handler("addEnd: list is NULL");
861 
862  /* first check to make sure this point is not in the list */
863  u1_cur = u1;
864  i1_cur = is1;
865  u2_cur = u2;
866  i2_cur = is2;
867  if(u1_cur == 1) {
868  u1_cur = 0;
869  i1_cur = ie1;
870  }
871  if(u2_cur == 1) {
872  u2_cur = 0;
873  i2_cur = ie2;
874  }
875 
876  if(list->initialized) {
877  temp = list;
878  while(temp) {
879  if( temp->u == u1_cur && temp->subj_index == i1_cur) return 0;
880  if( temp->u_clip == u2_cur && temp->clip_index == i2_cur) return 0;
881  if( !temp->Next ) break;
882  temp=temp->Next;
883  }
884 
885  /* Append at the end of the list. */
886  temp->Next = getNext();
887  temp = temp->Next;
888  }
889  else {
890  temp = list;
891  }
892 
893  temp->x = x;
894  temp->y = y;
895  temp->z = z;
896  temp->intersect = intersect;
897  temp->inbound = inbound;
898  temp->initialized=1;
899  temp->isInside = 0;
900  temp->u = u1_cur;
901  temp->subj_index = i1_cur;
902  temp->u_clip = u2_cur;
903  temp->clip_index = i2_cur;
904 
905  return 1;
906 }
907 
908 
909 int length(struct Node *list)
910 {
911  struct Node *cur_ptr=NULL;
912  int count=0;
913 
914  cur_ptr=list;
915 
916  while(cur_ptr)
917  {
918  if(cur_ptr->initialized ==0) break;
919  cur_ptr=cur_ptr->Next;
920  count++;
921  }
922  return(count);
923 }
924 
925 /* two points are the same if there are close enough */
926 int samePoint(double x1, double y1, double z1, double x2, double y2, double z2)
927 {
928  if( fabs(x1-x2) > EPSLN10 || fabs(y1-y2) > EPSLN10 || fabs(z1-z2) > EPSLN10 )
929  return 0;
930  else
931  return 1;
932 }
933 
934 
935 
936 int sameNode(struct Node node1, struct Node node2)
937 {
938  if( node1.x == node2.x && node1.y == node2.y && node1.z==node2.z )
939  return 1;
940  else
941  return 0;
942 }
943 
944 
945 void addNode(struct Node *list, struct Node inNode)
946 {
947 
948  addEnd(list, inNode.x, inNode.y, inNode.z, inNode.intersect, inNode.u, inNode.inbound, inNode.isInside);
949 
950 }
951 
952 struct Node *getNode(struct Node *list, struct Node inNode)
953 {
954  struct Node *thisNode=NULL;
955  struct Node *temp=NULL;
956 
957  temp = list;
958  while( temp ) {
959  if( sameNode( *temp, inNode ) ) {
960  thisNode = temp;
961  temp = NULL;
962  break;
963  }
964  temp = temp->Next;
965  }
966 
967  return thisNode;
968 }
969 
970 struct Node *getNextNode(struct Node *list)
971 {
972  return list->Next;
973 }
974 
975 void copyNode(struct Node *node_out, struct Node node_in)
976 {
977 
978  node_out->x = node_in.x;
979  node_out->y = node_in.y;
980  node_out->z = node_in.z;
981  node_out->u = node_in.u;
982  node_out->intersect = node_in.intersect;
983  node_out->inbound = node_in.inbound;
984  node_out->Next = NULL;
985  node_out->initialized = node_in.initialized;
986  node_out->isInside = node_in.isInside;
987 }
988 
989 void printNode(struct Node *list, char *str)
990 {
991  struct Node *temp;
992 
993  if(list == NULL) error_handler("printNode: list is NULL");
994  if(str) printf(" %s \n", str);
995  temp = list;
996  while(temp) {
997  if(temp->initialized ==0) break;
998  printf(" (x, y, z, interset, inbound, isInside) = (%19.15f,%19.15f,%19.15f,%d,%d,%d)\n",
999  temp->x, temp->y, temp->z, temp->intersect, temp->inbound, temp->isInside);
1000  temp = temp->Next;
1001  }
1002  printf("\n");
1003 }
1004 
1005 int intersectInList(struct Node *list, double x, double y, double z)
1006 {
1007  struct Node *temp;
1008  int found=0;
1009 
1010  temp = list;
1011  found = 0;
1012  while ( temp ) {
1013  if( temp->x == x && temp->y == y && temp->z == z ) {
1014  found = 1;
1015  break;
1016  }
1017  temp=temp->Next;
1018  }
1019  if (!found) error_handler("intersectInList: point (x,y,z) is not found in the list");
1020  if( temp->intersect == 2 )
1021  return 1;
1022  else
1023  return 0;
1024 
1025 }
1026 
1027 
1028 /* The following insert a intersection after non-intersect point (x2,y2,z2), if the point
1029  after (x2,y2,z2) is an intersection, if u is greater than the u value of the intersection,
1030  insert after, otherwise insert before
1031 */
1032 void insertIntersect(struct Node *list, double x, double y, double z, double u1, double u2, int inbound,
1033  double x2, double y2, double z2)
1034 {
1035  struct Node *temp1=NULL, *temp2=NULL;
1036  struct Node *temp;
1037  double u_cur;
1038  int found=0;
1039 
1040  temp1 = list;
1041  found = 0;
1042  while ( temp1 ) {
1043  if( temp1->x == x2 && temp1->y == y2 && temp1->z == z2 ) {
1044  found = 1;
1045  break;
1046  }
1047  temp1=temp1->Next;
1048  }
1049  if (!found) error_handler("inserAfter: point (x,y,z) is not found in the list");
1050 
1051  /* when u = 0 or u = 1, set the grid point to be the intersection point to solve truncation error isuse */
1052  u_cur = u1;
1053  if(u1 == 1) {
1054  u_cur = 0;
1055  temp1 = temp1->Next;
1056  if(!temp1) temp1 = list;
1057  }
1058  if(u_cur==0) {
1059  temp1->intersect = 2;
1060  temp1->isInside = 1;
1061  temp1->u = u_cur;
1062  temp1->x = x;
1063  temp1->y = y;
1064  temp1->z = z;
1065  return;
1066  }
1067 
1068  /* when u2 != 0 and u2 !=1, can decide if one end of the point is outside depending on inbound value */
1069  if(u2 != 0 && u2 != 1) {
1070  if(inbound == 1) { /* goes outside, then temp1->Next is an outside point */
1071  /* find the next non-intersect point */
1072  temp2 = temp1->Next;
1073  if(!temp2) temp2 = list;
1074  while(temp2->intersect) {
1075  temp2=temp2->Next;
1076  if(!temp2) temp2 = list;
1077  }
1078 
1079  temp2->isInside = 0;
1080  }
1081  else if(inbound ==2) { /* goes inside, then temp1 is an outside point */
1082  temp1->isInside = 0;
1083  }
1084  }
1085 
1086  temp2 = temp1->Next;
1087  while ( temp2 ) {
1088  if( temp2->intersect == 1 ) {
1089  if( temp2->u > u_cur ) {
1090  break;
1091  }
1092  }
1093  else
1094  break;
1095  temp1 = temp2;
1096  temp2 = temp2->Next;
1097  }
1098 
1099  /* assign value */
1100  temp = getNext();
1101  temp->x = x;
1102  temp->y = y;
1103  temp->z = z;
1104  temp->u = u_cur;
1105  temp->intersect = 1;
1106  temp->inbound = inbound;
1107  temp->isInside = 1;
1108  temp->initialized = 1;
1109  temp1->Next = temp;
1110  temp->Next = temp2;
1111 
1112 }
1113 
1114 double gridArea(struct Node *grid) {
1115  double x[20], y[20], z[20];
1116  struct Node *temp=NULL;
1117  double area;
1118  int n;
1119 
1120  temp = grid;
1121  n = 0;
1122  while( temp ) {
1123  x[n] = temp->x;
1124  y[n] = temp->y;
1125  z[n] = temp->z;
1126  n++;
1127  temp = temp->Next;
1128  }
1129 
1130  area = great_circle_area(n, x, y, z);
1131 
1132  return area;
1133 
1134 }
1135 
1136 int isIntersect(struct Node node) {
1137 
1138  return node.intersect;
1139 
1140 }
1141 
1142 
1143 int getInbound( struct Node node )
1144 {
1145  return node.inbound;
1146 }
1147 
1148 struct Node *getLast(struct Node *list)
1149 {
1150  struct Node *temp1;
1151 
1152  temp1 = list;
1153  if( temp1 ) {
1154  while( temp1->Next ) {
1155  temp1 = temp1->Next;
1156  }
1157  }
1158 
1159  return temp1;
1160 }
1161 
1162 
1163 int getFirstInbound( struct Node *list, struct Node *nodeOut)
1164 {
1165  struct Node *temp=NULL;
1166 
1167  temp=list;
1168 
1169  while(temp) {
1170  if( temp->inbound == 2 ) {
1171  copyNode(nodeOut, *temp);
1172  return 1;
1173  }
1174  temp=temp->Next;
1175  }
1176 
1177  return 0;
1178 }
1179 
1180 void getCoordinate(struct Node node, double *x, double *y, double *z)
1181 {
1182 
1183 
1184  *x = node.x;
1185  *y = node.y;
1186  *z = node.z;
1187 
1188 }
1189 
1190 void getCoordinates(struct Node *node, double *p)
1191 {
1192 
1193 
1194  p[0] = node->x;
1195  p[1] = node->y;
1196  p[2] = node->z;
1197 
1198 }
1199 
1200 void setCoordinate(struct Node *node, double x, double y, double z)
1201 {
1202 
1203 
1204  node->x = x;
1205  node->y = y;
1206  node->z = z;
1207 
1208 }
1209 
1210 /* set inbound value for the points in interList that has inbound =0,
1211  this will also set some inbound value of the points in list1
1212 */
1213 
1214 void setInbound(struct Node *interList, struct Node *list)
1215 {
1216 
1217  struct Node *temp1=NULL, *temp=NULL;
1218  struct Node *temp1_prev=NULL, *temp1_next=NULL;
1219  int prev_is_inside, next_is_inside;
1220 
1221  /* for each point in interList, search through list to decide the inbound value the interList point */
1222  /* For each inbound point, the prev node should be outside and the next is inside. */
1223  if(length(interList) == 0) return;
1224 
1225  temp = interList;
1226 
1227  while(temp) {
1228  if( !temp->inbound) {
1229  /* search in grid1 to find the prev and next point of temp, when prev point is outside and next point is inside
1230  inbound = 2, else inbound = 1*/
1231  temp1 = list;
1232  temp1_prev = NULL;
1233  temp1_next = NULL;
1234  while(temp1) {
1235  if(sameNode(*temp1, *temp)) {
1236  if(!temp1_prev) temp1_prev = getLast(list);
1237  temp1_next = temp1->Next;
1238  if(!temp1_next) temp1_next = list;
1239  break;
1240  }
1241  temp1_prev = temp1;
1242  temp1 = temp1->Next;
1243  }
1244  if(!temp1_next) error_handler("Error from create_xgrid.c: temp is not in list1");
1245  if( temp1_prev->isInside == 0 && temp1_next->isInside == 1)
1246  temp->inbound = 2; /* go inside */
1247  else
1248  temp->inbound = 1;
1249  }
1250  temp=temp->Next;
1251  }
1252 }
1253 
1254 int isInside(struct Node *node) {
1255 
1256  if(node->isInside == -1) error_handler("Error from mosaic_util.c: node->isInside is not set");
1257  return(node->isInside);
1258 
1259 }
1260 
1261 /* #define debug_test_create_xgrid */
1262 
1263 /* check if node is inside polygon list or not */
1264 int insidePolygon( struct Node *node, struct Node *list)
1265 {
1266  int is_inside;
1267  double pnt0[3], pnt1[3], pnt2[3];
1268  double anglesum;
1269  struct Node *p1=NULL, *p2=NULL;
1270 
1271  anglesum = 0;
1272 
1273  pnt0[0] = node->x;
1274  pnt0[1] = node->y;
1275  pnt0[2] = node->z;
1276 
1277  p1 = list;
1278  p2 = list->Next;
1279  is_inside = 0;
1280 
1281 
1282  while(p1) {
1283  pnt1[0] = p1->x;
1284  pnt1[1] = p1->y;
1285  pnt1[2] = p1->z;
1286  pnt2[0] = p2->x;
1287  pnt2[1] = p2->y;
1288  pnt2[2] = p2->z;
1289  if( samePoint(pnt0[0], pnt0[1], pnt0[2], pnt1[0], pnt1[1], pnt1[2]) ){
1290  return 1;
1291  }
1292  anglesum += spherical_angle(pnt0, pnt2, pnt1);
1293  p1 = p1->Next;
1294  p2 = p2->Next;
1295  if(p2==NULL){
1296  p2 = list;
1297  }
1298  }
1299 
1300  if( fabs(anglesum - 2*M_PI) < EPSLN8 ){
1301  is_inside = 1;
1302  }
1303  else{
1304  is_inside = 0;
1305  }
1306 
1307 #ifdef debug_test_create_xgrid
1308  printf("anglesum-2PI is %19.15f, is_inside = %d\n", anglesum- 2*M_PI, is_inside);
1309 #endif
1310 
1311  return is_inside;
1312 
1313 }
1314 
1315 int inside_a_polygon(double *lon1, double *lat1, int *npts, double *lon2, double *lat2)
1316 {
1317 
1318  double x2[20], y2[20], z2[20];
1319  double x1, y1, z1;
1320  double min_x2, max_x2, min_y2, max_y2, min_z2, max_z2;
1321  int isinside, i;
1322 
1323  struct Node *grid1=NULL, *grid2=NULL;
1324 
1325  /* first convert to cartesian grid */
1326  latlon2xyz(*npts, lon2, lat2, x2, y2, z2);
1327  latlon2xyz(1, lon1, lat1, &x1, &y1, &z1);
1328 
1329  max_x2 = maxval_double(*npts, x2);
1330  if(x1 >= max_x2+RANGE_CHECK_CRITERIA) return 0;
1331  min_x2 = minval_double(*npts, x2);
1332  if(min_x2 >= x1+RANGE_CHECK_CRITERIA) return 0;
1333 
1334  max_y2 = maxval_double(*npts, y2);
1335  if(y1 >= max_y2+RANGE_CHECK_CRITERIA) return 0;
1336  min_y2 = minval_double(*npts, y2);
1337  if(min_y2 >= y1+RANGE_CHECK_CRITERIA) return 0;
1338 
1339  max_z2 = maxval_double(*npts, z2);
1340  if(z1 >= max_z2+RANGE_CHECK_CRITERIA) return 0;
1341  min_z2 = minval_double(*npts, z2);
1342  if(min_z2 >= z1+RANGE_CHECK_CRITERIA) return 0;
1343 
1344 
1345  /* add x2,y2,z2 to a Node */
1346  rewindList();
1347  grid1 = getNext();
1348  grid2 = getNext();
1349 
1350  addEnd(grid1, x1, y1, z1, 0, 0, 0, -1);
1351  for(i=0; i<*npts; i++) addEnd(grid2, x2[i], y2[i], z2[i], 0, 0, 0, -1);
1352 
1353  isinside = insidePolygon(grid1, grid2);
1354 
1355  return isinside;
1356 
1357 }
1358 
1359 int inside_a_polygon_(double *lon1, double *lat1, int *npts, double *lon2, double *lat2)
1360 {
1361 
1362  int isinside;
1363 
1364  isinside = inside_a_polygon(lon1, lat1, npts, lon2, lat2);
1365 
1366  return isinside;
1367 
1368 }
pure elemental type(point) function latlon2xyz(lat, lon)
Return the (x,y,z) position of a given (lat,lon) point.
Definition: diag_grid.F90:1019
real(r8_kind), dimension(:,:), allocatable area
area of each grid box
integer nvar
No description.
integer function stderr()
This function returns the current standard fortran unit numbers for error messages.
Definition: mpp_util.inc:51