diff --git a/CMakeLists.txt b/CMakeLists.txt index aed1a0af88..17db1a4620 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -168,9 +168,7 @@ list(APPEND fms_fortran_src_files memutils/memutils.F90 monin_obukhov/monin_obukhov_inter.F90 monin_obukhov/monin_obukhov.F90 - mosaic/gradient.F90 - mosaic/grid.F90 - mosaic/mosaic.F90 + grid_utils/gradient.F90 mosaic2/grid2.F90 mosaic2/mosaic2.F90 mpp/mpp.F90 @@ -205,11 +203,10 @@ list(APPEND fms_fortran_src_files list(APPEND fms_c_src_files affinity/affinity.c fms/fms_stacksize.c - mosaic/create_xgrid.c - mosaic/gradient_c2l.c - mosaic/interp.c - mosaic/mosaic_util.c - mosaic/read_mosaic.c + grid_utils/gradient_c2l.c + grid_utils/grid_utils.c + grid_utils/tree_utils.c + horiz_interp/include/horiz_interp_conserve_xgrid.c mpp/mpp_memuse.c parser/yaml_parser_binding.c parser/yaml_output_functions.c @@ -300,7 +297,8 @@ foreach(kind ${kinds}) # C add_library(${libTgt}_c OBJECT ${fms_c_src_files}) - target_include_directories(${libTgt}_c PRIVATE include) + target_include_directories(${libTgt}_c PRIVATE include + grid_utils) target_compile_definitions(${libTgt}_c PRIVATE "${fms_defs}") target_link_libraries(${libTgt}_c PRIVATE NetCDF::NetCDF_C @@ -388,6 +386,7 @@ foreach(kind ${kinds}) $ $ $ + $ $ $ $ diff --git a/Makefile.am b/Makefile.am index b07346ea3e..c97869a75d 100644 --- a/Makefile.am +++ b/Makefile.am @@ -47,7 +47,7 @@ SUBDIRS = \ parser \ string_utils \ affinity \ - mosaic \ + grid_utils \ time_manager \ axis_utils \ diag_manager \ @@ -147,4 +147,3 @@ install-data-hook: @echo '| please see our page: https://www.github.com/NOAA-GFDL/FMS |' @echo '+-------------------------------------------------------------+' @echo '' - diff --git a/configure.ac b/configure.ac index a398b7637c..7079b9c450 100644 --- a/configure.ac +++ b/configure.ac @@ -479,7 +479,7 @@ AC_CONFIG_FILES([ tridiagonal/Makefile tracer_manager/Makefile topography/Makefile - mosaic/Makefile + grid_utils/Makefile mosaic2/Makefile monin_obukhov/Makefile memutils/Makefile @@ -541,4 +541,4 @@ AC_OUTPUT() if test $enable_deprecated_io = yes; then AC_MSG_WARN(FMS_IO WILL BE DEPRECATED IN A FUTURE RLEASE. PLEASE UPDATE TO USE FMS2_IO AND REMOVE --enable-deprecated-io FROM YOUR CONFIGURE OPTIONS) -fi \ No newline at end of file +fi diff --git a/mosaic/Makefile.am b/grid_utils/Makefile.am similarity index 77% rename from mosaic/Makefile.am rename to grid_utils/Makefile.am index 32166d34d3..1e80ba2c13 100644 --- a/mosaic/Makefile.am +++ b/grid_utils/Makefile.am @@ -28,32 +28,20 @@ AM_FCFLAGS = $(FC_MODINC). $(FC_MODOUT)$(MODDIR) # Build these uninstalled convenience libraries. -noinst_LTLIBRARIES = libmosaic.la +noinst_LTLIBRARIES = libgrid_utils.la -libmosaic_la_SOURCES = \ -mosaic.F90 \ -grid.F90 \ -gradient.F90 \ -create_xgrid.c \ +libgrid_utils_la_SOURCES = \ +grid_utils.c \ +grid_utils.h \ +tree_utils.c \ +tree_utils.h \ gradient_c2l.c \ -interp.c \ -mosaic_util.c \ -read_mosaic.c \ -constant.h \ -create_xgrid.h \ gradient_c2l.h \ -interp.h \ -mosaic_util.h \ -read_mosaic.h - -# Some mods are dependant on other mods in this dir. -grid_mod.$(FC_MODEXT): mosaic_mod.$(FC_MODEXT) +gradient.F90 \ +constant.h # Mod files are built and then installed as headers. -MODFILES = \ - mosaic_mod.$(FC_MODEXT) \ - grid_mod.$(FC_MODEXT) \ - gradient_mod.$(FC_MODEXT) +MODFILES = gradient_mod.$(FC_MODEXT) nodist_include_HEADERS = $(MODFILES) BUILT_SOURCES = $(MODFILES) diff --git a/mosaic/constant.h b/grid_utils/constant.h similarity index 80% rename from mosaic/constant.h rename to grid_utils/constant.h index 7dc75e3526..71f5b645ce 100644 --- a/mosaic/constant.h +++ b/grid_utils/constant.h @@ -16,5 +16,13 @@ * You should have received a copy of the GNU Lesser General Public * License along with FMS. If not, see . **********************************************************************/ -#define RADIUS (6371000.) -#define STRING 255 +#define RADIUS (6371000.) +#define STRING 255 + +#define EPSLN8 (1.e-8) +#define EPSLN15 (1.0e-15) +#define EPSLN30 (1.0e-30) +#define EPSLN10 (1.0e-10) +#define R2D (180/M_PI) +#define TPI (2.0*M_PI) +#define HPI (0.5*M_PI) diff --git a/mosaic/gradient.F90 b/grid_utils/gradient.F90 similarity index 100% rename from mosaic/gradient.F90 rename to grid_utils/gradient.F90 diff --git a/mosaic/gradient_c2l.c b/grid_utils/gradient_c2l.c similarity index 99% rename from mosaic/gradient_c2l.c rename to grid_utils/gradient_c2l.c index 0ab1658ffe..1afb15e9cf 100644 --- a/mosaic/gradient_c2l.c +++ b/grid_utils/gradient_c2l.c @@ -19,7 +19,7 @@ #include #include #include "constant.h" -#include "mosaic_util.h" +#include "grid_utils.h" #include "gradient_c2l.h" #include diff --git a/mosaic/gradient_c2l.h b/grid_utils/gradient_c2l.h similarity index 100% rename from mosaic/gradient_c2l.h rename to grid_utils/gradient_c2l.h diff --git a/grid_utils/grid_utils.c b/grid_utils/grid_utils.c new file mode 100644 index 0000000000..b2693054e5 --- /dev/null +++ b/grid_utils/grid_utils.c @@ -0,0 +1,1737 @@ +/*********************************************************************** + * GNU Lesser General Public License + * + * This file is part of the GFDL Flexible Modeling System (FMS). + * + * FMS 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. + * + * FMS 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 Lesser General Public + * License along with FMS. If not, see . + **********************************************************************/ +#include +#include +#include +#include +#include "grid_utils.h" +#include "tree_utils.h" +#include "constant.h" + +#ifdef use_libMPI +#include +#endif + +/** \file + * \ingroup mosaic + * \brief Error handling and other general utilities for @ref mosaic_mod + */ + +/*********************************************************** + void error_handler(char *str) + error handler: will print out error message and then abort +***********************************************************/ + +void error_handler(const char *msg) +{ + fprintf(stderr, "FATAL Error: %s\n", msg ); +#ifdef use_libMPI + MPI_Abort(MPI_COMM_WORLD, -1); +#else + exit(1); +#endif +} /* error_handler */ + + +/******************************************************************************* + double maxval_double(int size, double *data) + get the maximum value of double array +*******************************************************************************/ +double maxval_double(int size, const double *data) +{ + int n; + double maxval; + + maxval = data[0]; + for(n=1; n maxval ) maxval = data[n]; + } + + return maxval; + +} /* maxval_double */ + + +/******************************************************************************* + double minval_double(int size, double *data) + get the minimum value of double array +*******************************************************************************/ +double minval_double(int size, const double *data) +{ + int n; + double minval; + + minval = data[0]; + for(n=1; n=n_ins;i--) { + x[i+1] = x[i]; + y[i+1] = y[i]; + } + + x[n_ins] = lon_in; + y[n_ins] = lat_in; + return (n+1); +} /* insert_vtx */ + +void v_print(double x[], double y[], int n) +{ + int i; + + for (i=0;i=HPI-TOLERANCE) pole = 1; + if (0&&pole) { + printf("fixing pole cell\n"); + v_print(x, y, nn); + printf("---------"); + } + + /* all pole points must be paired */ + for (i=0;i=HPI-TOLERANCE) { + int im=(i+nn-1)%nn, ip=(i+1)%nn; + + if (y[im]==y[i] && y[ip]==y[i]) { + nn = delete_vtx(x, y, nn, i); + i--; + } else if (y[im]!=y[i] && y[ip]!=y[i]) { + nn = insert_vtx(x, y, nn, i, x[i], y[i]); + i++; + } + } + /* first of pole pair has longitude of previous vertex */ + /* second of pole pair has longitude of subsequent vertex */ + for (i=0;i=HPI-TOLERANCE) { + int im=(i+nn-1)%nn, ip=(i+1)%nn; + + if (y[im]!=y[i]){ + x[i] = x[im]; + } + if (y[ip]!=y[i]){ + x[i] = x[ip]; + } + } + + if (nn){ + x_sum = x[0]; + } + else{ + return(0); + } + for (i=1;i M_PI) dx_ = dx_ - TPI; + x_sum += (x[i] = x[i-1] + dx_); + } + + dx = (x_sum/nn)-tlon; + if (dx < -M_PI){ + for (i=0;i M_PI){ + for (i=0;i angle + \ + \ + p2 + -----------------------------------------------------------------------------*/ +double spherical_angle(const double *v1, const double *v2, const double *v3) +{ + double angle; + long double px, py, pz, qx, qy, qz, ddd; + + /* vector product between v1 and v2 */ + px = v1[1]*v2[2] - v1[2]*v2[1]; + py = v1[2]*v2[0] - v1[0]*v2[2]; + pz = v1[0]*v2[1] - v1[1]*v2[0]; + /* vector product between v1 and v3 */ + qx = v1[1]*v3[2] - v1[2]*v3[1]; + qy = v1[2]*v3[0] - v1[0]*v3[2]; + qz = v1[0]*v3[1] - v1[1]*v3[0]; + + ddd = (px*px+py*py+pz*pz)*(qx*qx+qy*qy+qz*qz); + if ( ddd <= 0.0 ) + angle = 0. ; + else { + ddd = (px*qx+py*qy+pz*qz) / sqrtl(ddd); + if( fabsl(ddd-1) < EPSLN30 ) ddd = 1; + if( fabsl(ddd+1) < EPSLN30 ) ddd = -1; + if ( ddd>1. || ddd<-1. ) { + /*FIX (lmh) to correctly handle co-linear points (angle near pi or 0) */ + if (ddd < 0.) + angle = M_PI; + else + angle = 0.; + } + else + angle = ((double)acosl( ddd )); + } + + return angle; +} /* spherical_angle */ + + +/*---------------------------------------------------------------------- + void vect_cross(e, p1, p2) + Perform cross products of 3D vectors: e = P1 X P2 + -------------------------------------------------------------------*/ + +void vect_cross(const double *p1, const double *p2, double *e ) +{ + + e[0] = p1[1]*p2[2] - p1[2]*p2[1]; + e[1] = p1[2]*p2[0] - p1[0]*p2[2]; + e[2] = p1[0]*p2[1] - p1[1]*p2[0]; + +} /* vect_cross */ + + +/*---------------------------------------------------------------------- + double* vect_cross(p1, p2) + return cross products of 3D vectors: = P1 X P2 + -------------------------------------------------------------------*/ + +double dot(const double *p1, const double *p2) +{ + + return( p1[0]*p2[0] + p1[1]*p2[1] + p1[2]*p2[2] ); + +} + + +double metric(const double *p) { + return (sqrt(p[0]*p[0] + p[1]*p[1]+p[2]*p[2]) ); +} + +void normalize_vect(double *e) +{ + double pdot; + int k; + + pdot = e[0]*e[0] + e[1] * e[1] + e[2] * e[2]; + pdot = sqrt( pdot ); + + for(k=0; k<3; k++) e[k] /= pdot; +} + + +/*------------------------------------------------------------------ + void unit_vect_latlon(int size, lon, lat, vlon, vlat) + calculate unit vector for latlon in cartesian coordinates + ---------------------------------------------------------------------*/ +void unit_vect_latlon(int size, const double *lon, const double *lat, double *vlon, double *vlat) +{ + double sin_lon, cos_lon, sin_lat, cos_lat; + int n; + + for(n=0; n= max_x2+RANGE_CHECK_CRITERIA) return 0; + min_x2 = minval_double(*npts, x2); + if(min_x2 >= x1+RANGE_CHECK_CRITERIA) return 0; + + max_y2 = maxval_double(*npts, y2); + if(y1 >= max_y2+RANGE_CHECK_CRITERIA) return 0; + min_y2 = minval_double(*npts, y2); + if(min_y2 >= y1+RANGE_CHECK_CRITERIA) return 0; + + max_z2 = maxval_double(*npts, z2); + if(z1 >= max_z2+RANGE_CHECK_CRITERIA) return 0; + min_z2 = minval_double(*npts, z2); + if(min_z2 >= z1+RANGE_CHECK_CRITERIA) return 0; + + + /* add x2,y2,z2 to a Node */ + rewindList(); + grid1 = getNext(); + grid2 = getNext(); + + addEnd(grid1, x1, y1, z1, 0, 0, 0, -1); + for(i=0; i<*npts; i++) addEnd(grid2, x2[i], y2[i], z2[i], 0, 0, 0, -1); + + isinside = insidePolygon(grid1, grid2); + + return isinside; + +} + +int inside_a_polygon_(double *lon1, double *lat1, int *npts, double *lon2, double *lat2) +{ + + int isinside; + + isinside = inside_a_polygon(lon1, lat1, npts, lon2, lat2); + + return isinside; + +} + +double get_global_area(void) +{ + double garea; + garea = 4*M_PI*RADIUS*RADIUS; + + return garea; +} + +double get_global_area_(void) +{ + double garea; + garea = 4*M_PI*RADIUS*RADIUS; + + return garea; +} + +double poly_area(const double x[], const double y[], int n) +{ + double area = 0.0; + int i; + + for (i=0;i M_PI) dx = dx - 2.0*M_PI; + if(dx < -M_PI) dx = dx + 2.0*M_PI; + if (dx==0.0) continue; + + if ( fabs(lat1-lat2) < SMALL_VALUE) /* cheap area calculation along latitude */ + area -= dx*sin(0.5*(lat1+lat2)); + else { + dy = 0.5*(lat1-lat2); + dat = sin(dy)/dy; + area -= dx*sin(0.5*(lat1+lat2))*dat; + } + } + if(area < 0) + return -area*RADIUS*RADIUS; + else + return area*RADIUS*RADIUS; + +} /* poly_area */ + +double poly_area_no_adjust(const double x[], const double y[], int n) +{ + double area = 0.0; + int i; + + for (i=0;i M_PI) dx = dx - 2.0*M_PI; + if(dx < -M_PI) dx = dx + 2.0*M_PI; + if (dx==0.0) continue; + + if ( fabs(lat1-lat2) < SMALL_VALUE) /* cheap area calculation along latitude */ + area -= dx*sin(0.5*(lat1+lat2)); + else { + dy = 0.5*(lat1-lat2); + dat = sin(dy)/dy; + area -= dx*sin(0.5*(lat1+lat2))*dat; + } + } + if(area < 0) + return (-area/(4*M_PI)); + else + return (area/(4*M_PI)); + +} /* poly_area */ + +/* Compute the great circle area of a polygon on a sphere */ +double great_circle_area(int n, const double *x, const double *y, const double *z) { + int i; + double pnt0[3], pnt1[3], pnt2[3]; + double sum, area; + + /* sum angles around polygon */ + sum=0.0; + for ( i=0; i= ll_lon); + for (i_in=0,i_out=0;i_in= ll_lon))!=inside_last) { + x_tmp[i_out] = ll_lon; + y_tmp[i_out++] = y_last + (ll_lon - x_last) * (lat_in[i_in] - y_last) / (lon_in[i_in] - x_last); + } + + /* if "to" point is right of LEFT boundary, output it */ + if (inside) { + x_tmp[i_out] = lon_in[i_in]; + y_tmp[i_out++] = lat_in[i_in]; + } + x_last = lon_in[i_in]; + y_last = lat_in[i_in]; + inside_last = inside; + } + if (!(n_out=i_out)) return(0); + + /* clip polygon with RIGHT boundary - clip V_TMP to V_OUT */ + x_last = x_tmp[n_out-1]; + y_last = y_tmp[n_out-1]; + inside_last = (x_last <= ur_lon); + for (i_in=0,i_out=0;i_in= ll_lat); + for (i_in=0,i_out=0;i_in= ll_lat))!=inside_last) { + y_tmp[i_out] = ll_lat; + x_tmp[i_out++] = x_last + (ll_lat - y_last) * (lon_out[i_in] - x_last) / (lat_out[i_in] - y_last); + } + + /* if "to" point is above BOTTOM boundary, output it */ + if (inside) { + x_tmp[i_out] = lon_out[i_in]; + y_tmp[i_out++] = lat_out[i_in]; + } + x_last = lon_out[i_in]; + y_last = lat_out[i_in]; + inside_last = inside; + } + if (!(n_out=i_out)) return(0); + + /* clip polygon with TOP boundary - clip V_TMP to V_OUT */ + x_last = x_tmp[n_out-1]; + y_last = y_tmp[n_out-1]; + inside_last = (y_last <= ur_lat); + for (i_in=0,i_out=0;i_in and + should not parallel to the line between and + may need to consider truncation error */ + dy1 = y1_1-y1_0; + dy2 = y2_1-y2_0; + dx1 = x1_1-x1_0; + dx2 = x2_1-x2_0; + ds1 = y1_0*x1_1 - y1_1*x1_0; + ds2 = y2_0*x2_1 - y2_1*x2_0; + determ = dy2*dx1 - dy1*dx2; + if(fabs(determ) < EPSLN30) { + error_handler("the line between and should not parallel to " + "the line between and "); + } + lon_out[i_out] = (dx2*ds1 - dx1*ds2)/determ; + lat_out[i_out++] = (dy2*ds1 - dy1*ds2)/determ; + + + } + if(inside) { + lon_out[i_out] = x1_1; + lat_out[i_out++] = y1_1; + } + x1_0 = x1_1; + y1_0 = y1_1; + inside_last = inside; + } + if(!(n_out=i_out)) return 0; + for(i1=0; i1= max_x2+RANGE_CHECK_CRITERIA) return 0; + max_x1 = maxval_double(n1_in, x1_in); + min_x2 = minval_double(n2_in, x2_in); + if(min_x2 >= max_x1+RANGE_CHECK_CRITERIA) return 0; + + min_y1 = minval_double(n1_in, y1_in); + max_y2 = maxval_double(n2_in, y2_in); + if(min_y1 >= max_y2+RANGE_CHECK_CRITERIA) return 0; + max_y1 = maxval_double(n1_in, y1_in); + min_y2 = minval_double(n2_in, y2_in); + if(min_y2 >= max_y1+RANGE_CHECK_CRITERIA) return 0; + + min_z1 = minval_double(n1_in, z1_in); + max_z2 = maxval_double(n2_in, z2_in); + if(min_z1 >= max_z2+RANGE_CHECK_CRITERIA) return 0; + max_z1 = maxval_double(n1_in, z1_in); + min_z2 = minval_double(n2_in, z2_in); + if(min_z2 >= max_z1+RANGE_CHECK_CRITERIA) return 0; + + rewindList(); + + grid1List = getNext(); + grid2List = getNext(); + intersectList = getNext(); + polyList = getNext(); + + /* insert points into SubjList and ClipList */ + for(i1=0; i1isInside = 1; + else + temp->isInside = 0; + temp = getNextNode(temp); + } + + /* check if grid2List is inside grid1List */ + temp = grid2List; + + while(temp) { + if(insidePolygon(temp, grid1List)) + temp->isInside = 1; + else + temp->isInside = 0; + temp = getNextNode(temp); + } + + /* make sure the grid box is clockwise */ + + /*make sure each polygon is convex, which is equivalent that the great_circle_area is positive */ + if( gridArea(grid1List) <= 0 ) + error_handler("create_xgrid.c(clip_2dx2d_great_circle): grid box 1 is not convex"); + if( gridArea(grid2List) <= 0 ) + error_handler("create_xgrid.c(clip_2dx2d_great_circle): grid box 2 is not convex"); + + /* get the coordinates from grid1List and grid2List. + Please not npts1 might not equal n1_in, npts2 might not equal n2_in because of pole + */ + + temp = grid1List; + for(i1=0; i1Next; + } + temp = grid2List; + for(i2=0; i2Next; + } + + firstIntersect=getNext(); + curIntersect = getNext(); + + /* first find all the intersection points */ + nintersect = 0; + for(i1=0; i1 1) { + getFirstInbound(intersectList, firstIntersect); + if(firstIntersect->initialized) { + has_inbound = 1; + } + } + + /* when has_inbound == 0, get the grid1List and grid2List */ + if( !has_inbound && nintersect > 1) { + setInbound(intersectList, grid1List); + getFirstInbound(intersectList, firstIntersect); + if(firstIntersect->initialized) has_inbound = 1; + } + + /* if has_inbound = 1, find the overlapping */ + n_out = 0; + + if(has_inbound) { + maxiter1 = nintersect; + temp1 = getNode(grid1List, *firstIntersect); + if( temp1 == NULL) { + double lon[10], lat[10]; + int i; + xyz2latlon(n1_in, x1_in, y1_in, z1_in, lon, lat); + for(i=0; i< n1_in; i++) printf("lon1 = %g, lat1 = %g\n", lon[i]*R2D, lat[i]*R2D); + printf("\n"); + xyz2latlon(n2_in, x2_in, y2_in, z2_in, lon, lat); + for(i=0; i< n2_in; i++) printf("lon2 = %g, lat2 = %g\n", lon[i]*R2D, lat[i]*R2D); + printf("\n"); + + error_handler("firstIntersect is not in the grid1List"); + } + addNode(polyList, *firstIntersect); + nintersect--; + + /* Loop over the grid1List and grid2List to find again the firstIntersect */ + curList = grid1List; + curListNum = 0; + + /* Loop through curList to find the next intersection, the loop will end + when come back to firstIntersect + */ + copyNode(curIntersect, *firstIntersect); + iter1 = 0; + found1 = 0; + + while( iter1 < maxiter1 ) { + /* find the curIntersect in curList and get the next intersection points */ + temp1 = getNode(curList, *curIntersect); + temp2 = temp1->Next; + if( temp2 == NULL ) temp2 = curList; + + maxiter2 = length(curList); + found2 = 0; + iter2 = 0; + /* Loop until find the next intersection */ + while( iter2 < maxiter2 ) { + int temp2IsIntersect; + + temp2IsIntersect = 0; + if( isIntersect( *temp2 ) ) { /* copy the point and switch to the grid2List */ + struct Node *temp3; + + /* first check if temp2 is the firstIntersect */ + if( sameNode( *temp2, *firstIntersect) ) { + found1 = 1; + break; + } + + temp3 = temp2->Next; + if( temp3 == NULL) temp3 = curList; + if( temp3 == NULL) error_handler("creat_xgrid.c: temp3 can not be NULL"); + found2 = 1; + /* if next node is inside or an intersection, + need to keep on curList + */ + temp2IsIntersect = 1; + if( isIntersect(*temp3) || (temp3->isInside == 1) ) found2 = 0; + } + if(found2) { + copyNode(curIntersect, *temp2); + break; + } + else { + addNode(polyList, *temp2); + if(temp2IsIntersect) { + nintersect--; + } + } + temp2 = temp2->Next; + if( temp2 == NULL ) temp2 = curList; + iter2 ++; + } + if(found1) break; + + if( !found2 ) error_handler(" not found the next intersection "); + + /* if find the first intersection, the poly found */ + if( sameNode( *curIntersect, *firstIntersect) ) { + found1 = 1; + break; + } + + /* add curIntersect to polyList and remove it from intersectList and curList */ + addNode(polyList, *curIntersect); + nintersect--; + + + /* switch curList */ + if( curListNum == 0) { + curList = grid2List; + curListNum = 1; + } + else { + curList = grid1List; + curListNum = 0; + } + iter1++; + } + if(!found1) error_handler("not return back to the first intersection"); + + /* currently we are only clipping convex polygon to convex polygon */ + if( nintersect > 0) error_handler("After clipping, nintersect should be 0"); + + /* copy the polygon to x_out, y_out, z_out */ + temp1 = polyList; + while (temp1 != NULL) { + getCoordinate(*temp1, x_out+n_out, y_out+n_out, z_out+n_out); + temp1 = temp1->Next; + n_out++; + } + + /* if(n_out < 3) error_handler(" The clipped region has < 3 vertices"); */ + if( n_out < 3) n_out = 0; + } + + /* check if grid1 is inside grid2 */ + if(n_out==0){ + /* first check number of points in grid1 is inside grid2 */ + int n, n1in2; + /* One possible is that grid1List is inside grid2List */ + n1in2 = 0; + temp = grid1List; + while(temp) { + if(temp->intersect != 1) { + if( temp->isInside == 1) n1in2++; + } + temp = getNextNode(temp); + } + if(npts1==n1in2) { /* grid1 is inside grid2 */ + n_out = npts1; + n = 0; + temp = grid1List; + while( temp ) { + getCoordinate(*temp, &x_out[n], &y_out[n], &z_out[n]); + n++; + temp = getNextNode(temp); + } + } + if(n_out>0) return n_out; + } + + /* check if grid2List is inside grid1List */ + if(n_out ==0){ + int n, n2in1; + + temp = grid2List; + n2in1 = 0; + while(temp) { + if(temp->intersect != 1) { + if( temp->isInside == 1) n2in1++; + } + temp = getNextNode(temp); + } + + if(npts2==n2in1) { /* grid2 is inside grid1 */ + n_out = npts2; + n = 0; + temp = grid2List; + while( temp ) { + getCoordinate(*temp, &x_out[n], &y_out[n], &z_out[n]); + n++; + temp = getNextNode(temp); + } + + } + } + + + return n_out; +} + + +/* Intersects between the line a and the seqment s + where both line and segment are great circle lines on the sphere represented by + 3D cartesian points. + [sin sout] are the ends of a line segment + returns true if the lines could be intersected, false otherwise. + inbound means the direction of (a1,a2) go inside or outside of (q1,q2,q3) +*/ + +int line_intersect_2D_3D(double *a1, double *a2, double *q1, double *q2, double *q3, + double *intersect, double *u_a, double *u_q, int *inbound){ + + /* Do this intersection by reprsenting the line a1 to a2 as a plane through the + two line points and the origin of the sphere (0,0,0). This is the + definition of a great circle arc. + */ + double plane[9]; + double plane_p[2]; + double u; + double p1[3], v1[3], v2[3]; + double c1[3], c2[3], c3[3]; + double coincident, sense, norm; + int i; + int is_inter1, is_inter2; + + *inbound = 0; + + /* first check if any vertices are the same */ + if(samePoint(a1[0], a1[1], a1[2], q1[0], q1[1], q1[2])) { + *u_a = 0; + *u_q = 0; + intersect[0] = a1[0]; + intersect[1] = a1[1]; + intersect[2] = a1[2]; + return 1; + } + else if (samePoint(a1[0], a1[1], a1[2], q2[0], q2[1], q2[2])) { + *u_a = 0; + *u_q = 1; + intersect[0] = a1[0]; + intersect[1] = a1[1]; + intersect[2] = a1[2]; + return 1; + } + else if(samePoint(a2[0], a2[1], a2[2], q1[0], q1[1], q1[2])) { + *u_a = 1; + *u_q = 0; + intersect[0] = a2[0]; + intersect[1] = a2[1]; + intersect[2] = a2[2]; + return 1; + } + else if (samePoint(a2[0], a2[1], a2[2], q2[0], q2[1], q2[2])) { + *u_a = 1; + *u_q = 1; + intersect[0] = a2[0]; + intersect[1] = a2[1]; + intersect[2] = a2[2]; + return 1; + } + + + /* Load points defining plane into variable (these are supposed to be in counterclockwise order) */ + plane[0]=q1[0]; + plane[1]=q1[1]; + plane[2]=q1[2]; + plane[3]=q2[0]; + plane[4]=q2[1]; + plane[5]=q2[2]; + plane[6]=0.0; + plane[7]=0.0; + plane[8]=0.0; + + /* Intersect the segment with the plane */ + is_inter1 = intersect_tri_with_line(plane, a1, a2, plane_p, u_a); + + if(!is_inter1) + return 0; + + if(fabs(*u_a) < EPSLN8) *u_a = 0; + if(fabs(*u_a-1) < EPSLN8) *u_a = 1; + + + if( (*u_a < 0) || (*u_a > 1) ) return 0; + + /* Load points defining plane into variable (these are supposed to be in counterclockwise order) */ + plane[0]=a1[0]; + plane[1]=a1[1]; + plane[2]=a1[2]; + plane[3]=a2[0]; + plane[4]=a2[1]; + plane[5]=a2[2]; + plane[6]=0.0; + plane[7]=0.0; + plane[8]=0.0; + + /* Intersect the segment with the plane */ + is_inter2 = intersect_tri_with_line(plane, q1, q2, plane_p, u_q); + + if(!is_inter2) + return 0; + + if(fabs(*u_q) < EPSLN8) *u_q = 0; + if(fabs(*u_q-1) < EPSLN8) *u_q = 1; + + + if( (*u_q < 0) || (*u_q > 1) ) return 0; + + u =*u_a; + + /* The two planes are coincidental */ + vect_cross(a1, a2, c1); + vect_cross(q1, q2, c2); + vect_cross(c1, c2, c3); + coincident = metric(c3); + + if(fabs(coincident) < EPSLN30) return 0; + + /* Calculate point of intersection */ + intersect[0]=a1[0] + u*(a2[0]-a1[0]); + intersect[1]=a1[1] + u*(a2[1]-a1[1]); + intersect[2]=a1[2] + u*(a2[2]-a1[2]); + + norm = metric( intersect ); + for(i = 0; i < 3; i ++) intersect[i] /= norm; + + /* when u_q =0 or u_q =1, the following could not decide the inbound value */ + if(*u_q != 0 && *u_q != 1){ + + p1[0] = a2[0]-a1[0]; + p1[1] = a2[1]-a1[1]; + p1[2] = a2[2]-a1[2]; + v1[0] = q2[0]-q1[0]; + v1[1] = q2[1]-q1[1]; + v1[2] = q2[2]-q1[2]; + v2[0] = q3[0]-q2[0]; + v2[1] = q3[1]-q2[1]; + v2[2] = q3[2]-q2[2]; + + vect_cross(v1, v2, c1); + vect_cross(v1, p1, c2); + + sense = dot(c1, c2); + *inbound = 1; + if(sense > 0) *inbound = 2; /* v1 going into v2 in CCW sense */ + } + + return 1; +} + + +/*------------------------------------------------------------------------------ + double poly_ctrlat(const double x[], const double y[], int n) + This routine is used to calculate the latitude of the centroid + ---------------------------------------------------------------------------*/ + +double poly_ctrlat(const double x[], const double y[], int n) +{ + double ctrlat = 0.0; + int i; + + for (i=0;i M_PI) dx = dx - 2.0*M_PI; + if(dx < -M_PI) dx = dx + 2.0*M_PI; + + if ( fabs(hdy)< SMALL_VALUE ) /* cheap area calculation along latitude */ + ctrlat -= dx*(2*cos(avg_y) + lat2*sin(avg_y) - cos(lat1) ); + else + ctrlat -= dx*( (sin(hdy)/hdy)*(2*cos(avg_y) + lat2*sin(avg_y)) - cos(lat1) ); + } + return (ctrlat*RADIUS*RADIUS); +} /* poly_ctrlat */ + +/*------------------------------------------------------------------------------ + double poly_ctrlon(const double x[], const double y[], int n, double clon) + This routine is used to calculate the lontitude of the centroid. + ---------------------------------------------------------------------------*/ +double poly_ctrlon(const double x[], const double y[], int n, double clon) +{ + double ctrlon = 0.0; + int i; + + for (i=0;i M_PI) dphi = dphi - 2.0*M_PI; + if(dphi < -M_PI) dphi = dphi + 2.0*M_PI; + dphi1 = phi1 - clon; + if( dphi1 > M_PI) dphi1 -= 2.0*M_PI; + if( dphi1 <-M_PI) dphi1 += 2.0*M_PI; + dphi2 = phi2 -clon; + if( dphi2 > M_PI) dphi2 -= 2.0*M_PI; + if( dphi2 <-M_PI) dphi2 += 2.0*M_PI; + + if(fabs(dphi2 -dphi1) < M_PI) { + ctrlon -= dphi * (dphi1*f1+dphi2*f2)/2.0; + } + else { + if(dphi1 > 0.0) + fac = M_PI; + else + fac = -M_PI; + fint = f1 + (f2-f1)*(fac-dphi1)/fabs(dphi); + ctrlon -= 0.5*dphi1*(dphi1-fac)*f1 - 0.5*dphi2*(dphi2+fac)*f2 + + 0.5*fac*(dphi1+dphi2)*fint; + } + + } + return (ctrlon*RADIUS*RADIUS); +} /* poly_ctrlon */ + +/******************************************************************************* + int inside_edge(double x0, double y0, double x1, double y1, double x, double y) + determine a point(x,y) is inside or outside a given edge with vertex, + (x0,y0) and (x1,y1). return 1 if inside and 0 if outside. is + the outward edge normal from vertex to . is the vector + from to . + if Inner produce * > 0, outside, otherwise inside. + inner product value = 0 also treate as inside. +*******************************************************************************/ +int inside_edge(double x0, double y0, double x1, double y1, double x, double y) +{ + const double SMALL = 1.e-12; + double product; + + product = ( x-x0 )*(y1-y0) + (x0-x1)*(y-y0); + return (product<=SMALL) ? 1:0; + +} /* inside_edge */ diff --git a/grid_utils/grid_utils.h b/grid_utils/grid_utils.h new file mode 100644 index 0000000000..d6d9e91046 --- /dev/null +++ b/grid_utils/grid_utils.h @@ -0,0 +1,143 @@ +/*********************************************************************** + * GNU Lesser General Public License + * + * This file is part of the GFDL Flexible Modeling System (FMS). + * + * FMS 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. + * + * FMS 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 Lesser General Public + * License along with FMS. If not, see . + **********************************************************************/ +/*********************************************************************** + mosaic_util.h + This header file provide some utilities routine that will be used in many tools. + + contact: Zhi.Liang@noaa.gov +***********************************************************************/ +#ifndef GRID_UTILS_H_ +#define GRID_UTILS_H_ + +#define TOLERANCE (1.e-6) +#ifndef RANGE_CHECK_CRITERIA +#define RANGE_CHECK_CRITERIA 0.05 +#endif + +#define MV 50 + +#define min(a,b) (ab ? a:b) +#define SMALL_VALUE ( 1.e-10 ) + +void error_handler(const char *msg); + +int lon_fix(double *x, double *y, int n_in, double tlon); + +double minval_double(int size, const double *data); + +double maxval_double(int size, const double *data); + +double avgval_double(int size, const double *data); + +void latlon2xyz(int size, const double *lon, const double *lat, double *x, double *y, double *z); + +void xyz2latlon(int size, const double *x, const double *y, const double *z, double *lon, double *lat); + +int delete_vtx(double x[], double y[], int n, int n_del); + +int insert_vtx(double x[], double y[], int n, int n_ins, double lon_in, double lat_in); + +int fix_lon(double lon[], double lat[], int n, double tlon); + +double great_circle_distance(double *p1, double *p2); + +void vect_cross(const double *p1, const double *p2, double *e ); + +double spherical_angle(const double *v1, const double *v2, const double *v3); + +double great_circle_area(int n, const double *x, const double *y, const double *z); + +double * cross(const double *p1, const double *p2); + +double dot(const double *p1, const double *p2); + +void normalize_vect(double *e); + +void unit_vect_latlon(int size, const double *lon, const double *lat, double *vlon, double *vlat); + +int intersect_tri_with_line(const double *plane, const double *l1, const double *l2, double *p, + double *t); + +int invert_matrix_3x3(long double m[], long double m_inv[]); + +void mult(long double m[], long double v[], long double out_v[]); + +double metric(const double *p); + +int inside_a_polygon( double *lon1, double *lat1, int *npts, double *lon2, double *lat2); + +int samePoint(double x1, double y1, double z1, double x2, double y2, double z2); + +int inside_a_polygon_(double *lon1, double *lat1, int *npts, double *lon2, double *lat2); + +int inside_edge(double x0, double y0, double x1, double y1, double x, double y); + +int line_intersect_2D_3D(double *a1, double *a2, double *q1, double *q2, double *q3, + double *intersect, double *u_a, double *u_q, int *inbound); + +double poly_ctrlon(const double lon[], const double lat[], int n, double clon); + +double poly_ctrlat(const double lon[], const double lat[], int n); + +int get_maxxgrid(void); + +int get_maxxgrid_(void); + +double get_global_area(void); + +double get_global_area_(void); + +double poly_area(const double lon[], const double lat[], int n); + +double poly_area_dimensionless(const double x[], const double y[], int n); + +double spherical_excess_area(const double* p_ll, const double* p_ul, + const double* p_lr, const double* p_ur, double radius); + +void get_grid_area(const int *nlon, const int *nlat, const double *lon, const double *lat, double *area); + +void get_grid_great_circle_area(const int *nlon, const int *nlat, const double *lon, const double *lat, double *area); + +void get_grid_area_no_adjust(const int *nlon, const int *nlat, const double *lon, const double *lat, double *area); + +int clip(const double lon_in[], const double lat_in[], int n_in, double ll_lon, double ll_lat, + double ur_lon, double ur_lat, double lon_out[], double lat_out[]); + +int clip_2dx2d(const double lon1_in[], const double lat1_in[], int n1_in, + const double lon2_in[], const double lat2_in[], int n2_in, + double lon_out[], double lat_out[]); + +int clip_2dx2d_great_circle(const double x1_in[], const double y1_in[], const double z1_in[], int n1_in, + const double x2_in[], const double y2_in[], const double z2_in [], int n2_in, + double x_out[], double y_out[], double z_out[]); + +void get_grid_area_ug(const int *npts, const double *lon, const double *lat, double *area); + +void get_grid_great_circle_area_ug(const int *npts, const double *lon, const double *lat, double *area); + +void get_grid_area_(const int *nlon, const int *nlat, const double *lon, const double *lat, double *area); + +void get_grid_great_circle_area_(const int *nlon, const int *nlat, const double *lon, const double *lat, double *area); + +void get_grid_area_ug_(const int *npts, const double *lon, const double *lat, double *area); + +void get_grid_great_circle_area_ug_(const int *npts, const double *lon, const double *lat, double *area); + +#endif diff --git a/grid_utils/tree_utils.c b/grid_utils/tree_utils.c new file mode 100644 index 0000000000..96cac1ab06 --- /dev/null +++ b/grid_utils/tree_utils.c @@ -0,0 +1,572 @@ +/*********************************************************************** + * GNU Lesser General Public License + * + * This file is part of the GFDL Flexible Modeling System (FMS). + * + * FMS 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. + * + * FMS 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 Lesser General Public + * License along with FMS. If not, see . + **********************************************************************/ +#include +#include +#include +#include +#include "grid_utils.h" +#include "tree_utils.h" +#include "constant.h" + +/** \file + * \ingroup tree_utils + * \brief utilities for create_xgrid_great_circle + */ + +struct Node *nodeList=NULL; +int curListPos=0; + +void rewindList(void) +{ + int n; + + curListPos = 0; + if(!nodeList) nodeList = (struct Node *)malloc(MAXNODELIST*sizeof(struct Node)); + for(n=0; n MAXNODELIST) error_handler("getNext: curListPos >= MAXNODELIST"); + + return (temp); +} + + +void initNode(struct Node *node) +{ + node->x = 0; + node->y = 0; + node->z = 0; + node->u = 0; + node->intersect = 0; + node->inbound = 0; + node->isInside = 0; + node->Next = NULL; + node->initialized=0; + +} + +void addEnd(struct Node *list, double x, double y, double z, int intersect, double u, int inbound, int inside) +{ + + struct Node *temp=NULL; + + if(list == NULL) error_handler("addEnd: list is NULL"); + + if(list->initialized) { + + /* (x,y,z) might already in the list when intersect is true and u=0 or 1 */ + temp = list; + while (temp) { + if(samePoint(temp->x, temp->y, temp->z, x, y, z)) return; + temp=temp->Next; + } + temp = list; + while(temp->Next) + temp=temp->Next; + + /* Append at the end of the list. */ + temp->Next = getNext(); + temp = temp->Next; + } + else { + temp = list; + } + + temp->x = x; + temp->y = y; + temp->z = z; + temp->u = u; + temp->intersect = intersect; + temp->inbound = inbound; + temp->initialized=1; + temp->isInside = inside; +} + +/* return 1 if the point (x,y,z) is added in the list, return 0 if it is already in the list */ + +int addIntersect(struct Node *list, double x, double y, double z, int intersect, double u1, double u2, int inbound, + int is1, int ie1, int is2, int ie2) +{ + + double u1_cur, u2_cur; + int i1_cur, i2_cur; + struct Node *temp=NULL; + + if(list == NULL) error_handler("addEnd: list is NULL"); + + /* first check to make sure this point is not in the list */ + u1_cur = u1; + i1_cur = is1; + u2_cur = u2; + i2_cur = is2; + if(u1_cur == 1) { + u1_cur = 0; + i1_cur = ie1; + } + if(u2_cur == 1) { + u2_cur = 0; + i2_cur = ie2; + } + + if(list->initialized) { + temp = list; + while(temp) { + if( temp->u == u1_cur && temp->subj_index == i1_cur) return 0; + if( temp->u_clip == u2_cur && temp->clip_index == i2_cur) return 0; + if( !temp->Next ) break; + temp=temp->Next; + } + + /* Append at the end of the list. */ + temp->Next = getNext(); + temp = temp->Next; + } + else { + temp = list; + } + + temp->x = x; + temp->y = y; + temp->z = z; + temp->intersect = intersect; + temp->inbound = inbound; + temp->initialized=1; + temp->isInside = 0; + temp->u = u1_cur; + temp->subj_index = i1_cur; + temp->u_clip = u2_cur; + temp->clip_index = i2_cur; + + return 1; +} + + +int length(struct Node *list) +{ + struct Node *cur_ptr=NULL; + int count=0; + + cur_ptr=list; + + while(cur_ptr) + { + if(cur_ptr->initialized ==0) break; + cur_ptr=cur_ptr->Next; + count++; + } + return(count); +} + +/* two points are the same if there are close enough */ +int samePoint(double x1, double y1, double z1, double x2, double y2, double z2) +{ + if( fabs(x1-x2) > EPSLN10 || fabs(y1-y2) > EPSLN10 || fabs(z1-z2) > EPSLN10 ) + return 0; + else + return 1; +} + + +int sameNode(struct Node node1, struct Node node2) +{ + if( node1.x == node2.x && node1.y == node2.y && node1.z==node2.z ) + return 1; + else + return 0; +} + + +void addNode(struct Node *list, struct Node inNode) +{ + + addEnd(list, inNode.x, inNode.y, inNode.z, inNode.intersect, inNode.u, inNode.inbound, inNode.isInside); + +} + +struct Node *getNode(struct Node *list, struct Node inNode) +{ + struct Node *thisNode=NULL; + struct Node *temp=NULL; + + temp = list; + while( temp ) { + if( sameNode( *temp, inNode ) ) { + thisNode = temp; + temp = NULL; + break; + } + temp = temp->Next; + } + + return thisNode; +} + +struct Node *getNextNode(struct Node *list) +{ + return list->Next; +} + +void copyNode(struct Node *node_out, struct Node node_in) +{ + + node_out->x = node_in.x; + node_out->y = node_in.y; + node_out->z = node_in.z; + node_out->u = node_in.u; + node_out->intersect = node_in.intersect; + node_out->inbound = node_in.inbound; + node_out->Next = NULL; + node_out->initialized = node_in.initialized; + node_out->isInside = node_in.isInside; +} + +void printNode(struct Node *list, char *str) +{ + struct Node *temp; + + if(list == NULL) error_handler("printNode: list is NULL"); + if(str) printf(" %s \n", str); + temp = list; + while(temp) { + if(temp->initialized ==0) break; + printf(" (x, y, z, interset, inbound, isInside) = (%19.15f,%19.15f,%19.15f,%d,%d,%d)\n", + temp->x, temp->y, temp->z, temp->intersect, temp->inbound, temp->isInside); + temp = temp->Next; + } + printf("\n"); +} + +int intersectInList(struct Node *list, double x, double y, double z) +{ + struct Node *temp; + int found=0; + + temp = list; + found = 0; + while ( temp ) { + if( temp->x == x && temp->y == y && temp->z == z ) { + found = 1; + break; + } + temp=temp->Next; + } + if (!found) error_handler("intersectInList: point (x,y,z) is not found in the list"); + if( temp->intersect == 2 ) + return 1; + else + return 0; + +} + + +/* The following insert a intersection after non-intersect point (x2,y2,z2), if the point + after (x2,y2,z2) is an intersection, if u is greater than the u value of the intersection, + insert after, otherwise insert before +*/ +void insertIntersect(struct Node *list, double x, double y, double z, double u1, double u2, int inbound, + double x2, double y2, double z2) +{ + struct Node *temp1=NULL, *temp2=NULL; + struct Node *temp; + double u_cur; + int found=0; + + temp1 = list; + found = 0; + while ( temp1 ) { + if( temp1->x == x2 && temp1->y == y2 && temp1->z == z2 ) { + found = 1; + break; + } + temp1=temp1->Next; + } + if (!found) error_handler("inserAfter: point (x,y,z) is not found in the list"); + + /* when u = 0 or u = 1, set the grid point to be the intersection point to solve truncation error isuse */ + u_cur = u1; + if(u1 == 1) { + u_cur = 0; + temp1 = temp1->Next; + if(!temp1) temp1 = list; + } + if(u_cur==0) { + temp1->intersect = 2; + temp1->isInside = 1; + temp1->u = u_cur; + temp1->x = x; + temp1->y = y; + temp1->z = z; + return; + } + + /* when u2 != 0 and u2 !=1, can decide if one end of the point is outside depending on inbound value */ + if(u2 != 0 && u2 != 1) { + if(inbound == 1) { /* goes outside, then temp1->Next is an outside point */ + /* find the next non-intersect point */ + temp2 = temp1->Next; + if(!temp2) temp2 = list; + while(temp2->intersect) { + temp2=temp2->Next; + if(!temp2) temp2 = list; + } + + temp2->isInside = 0; + } + else if(inbound ==2) { /* goes inside, then temp1 is an outside point */ + temp1->isInside = 0; + } + } + + temp2 = temp1->Next; + while ( temp2 ) { + if( temp2->intersect == 1 ) { + if( temp2->u > u_cur ) { + break; + } + } + else + break; + temp1 = temp2; + temp2 = temp2->Next; + } + + /* assign value */ + temp = getNext(); + temp->x = x; + temp->y = y; + temp->z = z; + temp->u = u_cur; + temp->intersect = 1; + temp->inbound = inbound; + temp->isInside = 1; + temp->initialized = 1; + temp1->Next = temp; + temp->Next = temp2; + +} + +double gridArea(struct Node *grid) { + double x[20], y[20], z[20]; + struct Node *temp=NULL; + double area; + int n; + + temp = grid; + n = 0; + while( temp ) { + x[n] = temp->x; + y[n] = temp->y; + z[n] = temp->z; + n++; + temp = temp->Next; + } + + area = great_circle_area(n, x, y, z); + + return area; + +} + +int isIntersect(struct Node node) { + + return node.intersect; + +} + + +int getInbound( struct Node node ) +{ + return node.inbound; +} + +struct Node *getLast(struct Node *list) +{ + struct Node *temp1; + + temp1 = list; + if( temp1 ) { + while( temp1->Next ) { + temp1 = temp1->Next; + } + } + + return temp1; +} + + +int getFirstInbound( struct Node *list, struct Node *nodeOut) +{ + struct Node *temp=NULL; + + temp=list; + + while(temp) { + if( temp->inbound == 2 ) { + copyNode(nodeOut, *temp); + return 1; + } + temp=temp->Next; + } + + return 0; +} + +void getCoordinate(struct Node node, double *x, double *y, double *z) +{ + + + *x = node.x; + *y = node.y; + *z = node.z; + +} + +void getCoordinates(struct Node *node, double *p) +{ + + + p[0] = node->x; + p[1] = node->y; + p[2] = node->z; + +} + +void setCoordinate(struct Node *node, double x, double y, double z) +{ + + + node->x = x; + node->y = y; + node->z = z; + +} + +/* set inbound value for the points in interList that has inbound =0, + this will also set some inbound value of the points in list1 +*/ + +void setInbound(struct Node *interList, struct Node *list) +{ + + struct Node *temp1=NULL, *temp=NULL; + struct Node *temp1_prev=NULL, *temp1_next=NULL; + int prev_is_inside, next_is_inside; + + /* for each point in interList, search through list to decide the inbound value the interList point */ + /* For each inbound point, the prev node should be outside and the next is inside. */ + if(length(interList) == 0) return; + + temp = interList; + + while(temp) { + if( !temp->inbound) { + /* search in grid1 to find the prev and next point of temp, when prev point is outside and next point is inside + inbound = 2, else inbound = 1*/ + temp1 = list; + temp1_prev = NULL; + temp1_next = NULL; + while(temp1) { + if(sameNode(*temp1, *temp)) { + if(!temp1_prev) temp1_prev = getLast(list); + temp1_next = temp1->Next; + if(!temp1_next) temp1_next = list; + break; + } + temp1_prev = temp1; + temp1 = temp1->Next; + } + if(!temp1_next) error_handler("Error from create_xgrid.c: temp is not in list1"); + if( temp1_prev->isInside == 0 && temp1_next->isInside == 1) + temp->inbound = 2; /* go inside */ + else + temp->inbound = 1; + } + temp=temp->Next; + } +} + +int isInside(struct Node *node) { + + if(node->isInside == -1) error_handler("Error from mosaic_util.c: node->isInside is not set"); + return(node->isInside); + +} + +/* #define debug_test_create_xgrid */ + +/* check if node is inside polygon list or not */ +int insidePolygon( struct Node *node, struct Node *list) +{ + int is_inside; + double pnt0[3], pnt1[3], pnt2[3]; + double anglesum; + struct Node *p1=NULL, *p2=NULL; + + anglesum = 0; + + pnt0[0] = node->x; + pnt0[1] = node->y; + pnt0[2] = node->z; + + p1 = list; + p2 = list->Next; + is_inside = 0; + + + while(p1) { + pnt1[0] = p1->x; + pnt1[1] = p1->y; + pnt1[2] = p1->z; + pnt2[0] = p2->x; + pnt2[1] = p2->y; + pnt2[2] = p2->z; + if( samePoint(pnt0[0], pnt0[1], pnt0[2], pnt1[0], pnt1[1], pnt1[2]) ){ + return 1; + } + anglesum += spherical_angle(pnt0, pnt2, pnt1); + p1 = p1->Next; + p2 = p2->Next; + if(p2==NULL){ + p2 = list; + } + } + + if( fabs(anglesum - 2*M_PI) < EPSLN8 ){ + is_inside = 1; + } + else{ + is_inside = 0; + } + + return is_inside; + +} diff --git a/mosaic/mosaic_util.h b/grid_utils/tree_utils.h similarity index 55% rename from mosaic/mosaic_util.h rename to grid_utils/tree_utils.h index c12eb08d03..572fe0a350 100644 --- a/mosaic/mosaic_util.h +++ b/grid_utils/tree_utils.h @@ -22,17 +22,13 @@ contact: Zhi.Liang@noaa.gov ***********************************************************************/ -#ifndef MOSAIC_UTIL_H_ -#define MOSAIC_UTIL_H_ +#ifndef TREE_UTILS_H_ +#define TREE_UTILS_H_ -#ifndef RANGE_CHECK_CRITERIA -#define RANGE_CHECK_CRITERIA 0.05 +#ifndef MAXNODELIST +#define MAXNODELIST 100 #endif -#define min(a,b) (ab ? a:b) -#define SMALL_VALUE ( 1.e-10 ) - struct Node{ double x, y, z, u, u_clip; int intersect; /* indicate if this point is an intersection, 0 = no, 1= yes, 2=both intersect and vertices */ @@ -44,72 +40,6 @@ struct Node{ struct Node *Next; }; - -void error_handler(const char *msg); - -int nearest_index(double value, const double *array, int ia); - -int lon_fix(double *x, double *y, int n_in, double tlon); - -double minval_double(int size, const double *data); - -double maxval_double(int size, const double *data); - -double avgval_double(int size, const double *data); - -void latlon2xyz(int size, const double *lon, const double *lat, double *x, double *y, double *z); - -void xyz2latlon(int size, const double *x, const double *y, const double *z, double *lon, double *lat); - -double box_area(double ll_lon, double ll_lat, double ur_lon, double ur_lat); - -double poly_area(const double lon[], const double lat[], int n); - -int delete_vtx(double x[], double y[], int n, int n_del); - -int insert_vtx(double x[], double y[], int n, int n_ins, double lon_in, double lat_in); - -double poly_area_dimensionless(const double lon[], const double lat[], int n); - -double poly_area_no_adjust(const double x[], const double y[], int n); - -int fix_lon(double lon[], double lat[], int n, double tlon); - -void tokenize(const char * const string, const char *tokens, unsigned int varlen, - unsigned int maxvar, char * pstring, unsigned int * const nstr); - -double great_circle_distance(double *p1, double *p2); - -double spherical_excess_area(const double* p_ll, const double* p_ul, - const double* p_lr, const double* p_ur, double radius); - -void vect_cross(const double *p1, const double *p2, double *e ); - -double spherical_angle(const double *v1, const double *v2, const double *v3); - -void normalize_vect(double *e); - -void unit_vect_latlon(int size, const double *lon, const double *lat, double *vlon, double *vlat); - -double great_circle_area(int n, const double *x, const double *y, const double *z); - -double * cross(const double *p1, const double *p2); - -double dot(const double *p1, const double *p2); - -int intersect_tri_with_line(const double *plane, const double *l1, const double *l2, double *p, - double *t); - -int invert_matrix_3x3(long double m[], long double m_inv[]); - -void mult(long double m[], long double v[], long double out_v[]); - -double metric(const double *p); - -int insidePolygon(struct Node *node, struct Node *list ); - -int inside_a_polygon( double *lon1, double *lat1, int *npts, double *lon2, double *lat2); - void rewindList(void); struct Node *getNext(); @@ -123,8 +53,6 @@ int addIntersect(struct Node *list, double x, double y, double z, int intersect, int length(struct Node *list); -int samePoint(double x1, double y1, double z1, double x2, double y2, double z2); - int sameNode(struct Node node1, struct Node node2); void addNode(struct Node *list, struct Node nodeIn); @@ -165,6 +93,6 @@ void setInbound(struct Node *interList, struct Node *list); int isInside(struct Node *node); -int inside_a_polygon_(double *lon1, double *lat1, int *npts, double *lon2, double *lat2); +int insidePolygon( struct Node *node, struct Node *list); #endif diff --git a/horiz_interp/Makefile.am b/horiz_interp/Makefile.am index 55f8f1cbbd..3c5289e62a 100644 --- a/horiz_interp/Makefile.am +++ b/horiz_interp/Makefile.am @@ -23,7 +23,7 @@ # Ed Hartnett 2/22/19 # Include .h and .mod files. -AM_CPPFLAGS = -I$(top_srcdir)/include -I$(top_srcdir)/horiz_interp/include +AM_CPPFLAGS = -I$(top_srcdir)/include -I$(top_srcdir)/horiz_interp/include -I$(top_srcdir)/grid_utils AM_FCFLAGS = $(FC_MODINC). $(FC_MODOUT)$(MODDIR) # Build these uninstalled convenience libraries. @@ -44,6 +44,8 @@ libhoriz_interp_la_SOURCES = \ include/horiz_interp_spherical.inc \ include/horiz_interp_type.inc \ include/horiz_interp_bicubic_r4.fh \ + include/horiz_interp_conserve_xgrid.h \ + include/horiz_interp_conserve_xgrid.c \ include/horiz_interp_bilinear_r4.fh \ include/horiz_interp_conserve_r4.fh \ include/horiz_interp_r4.fh \ diff --git a/horiz_interp/include/horiz_interp_conserve_xgrid.c b/horiz_interp/include/horiz_interp_conserve_xgrid.c new file mode 100644 index 0000000000..9b7233ea13 --- /dev/null +++ b/horiz_interp/include/horiz_interp_conserve_xgrid.c @@ -0,0 +1,1321 @@ +/*********************************************************************** + * GNU Lesser General Public License + * + * This file is part of the GFDL Flexible Modeling System (FMS). + * + * FMS 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. + * + * FMS 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 Lesser General Public + * License along with FMS. If not, see . + **********************************************************************/ +#include +#include +#include +#include "grid_utils.h" +#include "tree_utils.h" +#include "horiz_interp_conserve_xgrid.h" +#include "constant.h" + +#if defined(_OPENMP) +#include +#endif + +/** \file + * \ingroup mosaic + * \brief Grid creation and calculation functions for use in @ref mosaic_mod + * / + +/******************************************************************************* + void create_xgrid_1dx2d_order1 + This routine generate exchange grids between two grids for the first order + conservative interpolation. nlon_in,nlat_in,nlon_out,nlat_out are the size of the grid cell + and lon_in,lat_in are 1-D grid bounds, lon_out,lat_out are geographic grid location of grid cell bounds. +*******************************************************************************/ +int create_xgrid_1dx2d_order1_(const int *nlon_in, const int *nlat_in, const int *nlon_out, const int *nlat_out, + const double *lon_in, const double *lat_in, const double *lon_out, const double *lat_out, + const double *mask_in, int *i_in, int *j_in, int *i_out, int *j_out, double *xgrid_area) +{ + int nxgrid; + + nxgrid = create_xgrid_1dx2d_order1(nlon_in, nlat_in, nlon_out, nlat_out, lon_in, lat_in, lon_out, lat_out, mask_in, + i_in, j_in, i_out, j_out, xgrid_area); + return nxgrid; + +} + +int create_xgrid_1dx2d_order1(const int *nlon_in, const int *nlat_in, const int *nlon_out, const int *nlat_out, const double *lon_in, + const double *lat_in, const double *lon_out, const double *lat_out, + const double *mask_in, int *i_in, int *j_in, int *i_out, + int *j_out, double *xgrid_area) +{ + + int nx1, ny1, nx2, ny2, nx1p, nx2p; + int i1, j1, i2, j2, nxgrid; + double ll_lon, ll_lat, ur_lon, ur_lat, x_in[MV], y_in[MV], x_out[MV], y_out[MV]; + double *area_in, *area_out, min_area; + double *tmpx, *tmpy; + + nx1 = *nlon_in; + ny1 = *nlat_in; + nx2 = *nlon_out; + ny2 = *nlat_out; + + nxgrid = 0; + nx1p = nx1 + 1; + nx2p = nx2 + 1; + + area_in = (double *)malloc(nx1*ny1*sizeof(double)); + area_out = (double *)malloc(nx2*ny2*sizeof(double)); + tmpx = (double *)malloc((nx1+1)*(ny1+1)*sizeof(double)); + tmpy = (double *)malloc((nx1+1)*(ny1+1)*sizeof(double)); + for(j1=0; j1<=ny1; j1++) for(i1=0; i1<=nx1; i1++) { + tmpx[j1*nx1p+i1] = lon_in[i1]; + tmpy[j1*nx1p+i1] = lat_in[j1]; + } + /* This is just a temporary fix to solve the issue that there is one point in zonal direction */ + if(nx1 > 1) + get_grid_area(nlon_in, nlat_in, tmpx, tmpy, area_in); + else + get_grid_area_no_adjust(nlon_in, nlat_in, tmpx, tmpy, area_in); + + get_grid_area(nlon_out, nlat_out, lon_out, lat_out, area_out); + free(tmpx); + free(tmpy); + + for(j1=0; j1 MASK_THRESH ) { + + ll_lon = lon_in[i1]; ll_lat = lat_in[j1]; + ur_lon = lon_in[i1+1]; ur_lat = lat_in[j1+1]; + for(j2=0; j2=ur_lat) && (y_in[1]>=ur_lat) + && (y_in[2]>=ur_lat) && (y_in[3]>=ur_lat) ) continue; + + x_in[0] = lon_out[j2*nx2p+i2]; + x_in[1] = lon_out[j2*nx2p+i2+1]; + x_in[2] = lon_out[(j2+1)*nx2p+i2+1]; + x_in[3] = lon_out[(j2+1)*nx2p+i2]; + n_in = fix_lon(x_in, y_in, 4, (ll_lon+ur_lon)/2); + + if ( (n_out = clip ( x_in, y_in, n_in, ll_lon, ll_lat, ur_lon, ur_lat, x_out, y_out )) > 0 ) { + Xarea = poly_area (x_out, y_out, n_out ) * mask_in[j1*nx1+i1]; + min_area = min(area_in[j1*nx1+i1], area_out[j2*nx2+i2]); + if( Xarea/min_area > AREA_RATIO_THRESH ) { + xgrid_area[nxgrid] = Xarea; + i_in[nxgrid] = i1; + j_in[nxgrid] = j1; + i_out[nxgrid] = i2; + j_out[nxgrid] = j2; + ++nxgrid; + if(nxgrid > MAXXGRID) error_handler("nxgrid is greater than MAXXGRID, increase MAXXGRID"); + } + } + } + } + + free(area_in); + free(area_out); + + return nxgrid; + +} /* create_xgrid_1dx2d_order1 */ + + +/******************************************************************************* + void create_xgrid_1dx2d_order1_ug + This routine generate exchange grids between two grids for the first order + conservative interpolation. nlon_in,nlat_in,nlon_out,nlat_out are the size of the grid cell + and lon_in,lat_in are 1-D grid bounds, lon_out,lat_out are geographic grid location of grid cell bounds. +*******************************************************************************/ +int create_xgrid_1dx2d_order1_ug_(const int *nlon_in, const int *nlat_in, const int *npts_out, + const double *lon_in, const double *lat_in, const double *lon_out, const double *lat_out, + const double *mask_in, int *i_in, int *j_in, int *l_out, double *xgrid_area) +{ + int nxgrid; + + nxgrid = create_xgrid_1dx2d_order1_ug(nlon_in, nlat_in, npts_out, lon_in, lat_in, lon_out, lat_out, mask_in, + i_in, j_in, l_out, xgrid_area); + return nxgrid; + +} + +int create_xgrid_1dx2d_order1_ug(const int *nlon_in, const int *nlat_in, const int *npts_out, const double *lon_in, + const double *lat_in, const double *lon_out, const double *lat_out, + const double *mask_in, int *i_in, int *j_in, int *l_out, double *xgrid_area) +{ + + int nx1, ny1, nx1p, nv, npts2; + int i1, j1, l2, nxgrid; + double ll_lon, ll_lat, ur_lon, ur_lat, x_in[MV], y_in[MV], x_out[MV], y_out[MV]; + double *area_in, *area_out, min_area; + double *tmpx, *tmpy; + + nx1 = *nlon_in; + ny1 = *nlat_in; + nv = 4; + npts2 = *npts_out; + + nxgrid = 0; + nx1p = nx1 + 1; + + area_in = (double *)malloc(nx1*ny1*sizeof(double)); + area_out = (double *)malloc(npts2*sizeof(double)); + tmpx = (double *)malloc((nx1+1)*(ny1+1)*sizeof(double)); + tmpy = (double *)malloc((nx1+1)*(ny1+1)*sizeof(double)); + for(j1=0; j1<=ny1; j1++) for(i1=0; i1<=nx1; i1++) { + tmpx[j1*nx1p+i1] = lon_in[i1]; + tmpy[j1*nx1p+i1] = lat_in[j1]; + } + /* This is just a temporary fix to solve the issue that there is one point in zonal direction */ + if(nx1 > 1) + get_grid_area(nlon_in, nlat_in, tmpx, tmpy, area_in); + else + get_grid_area_no_adjust(nlon_in, nlat_in, tmpx, tmpy, area_in); + + get_grid_area_ug(npts_out, lon_out, lat_out, area_out); + free(tmpx); + free(tmpy); + + for(j1=0; j1 MASK_THRESH ) { + + ll_lon = lon_in[i1]; ll_lat = lat_in[j1]; + ur_lon = lon_in[i1+1]; ur_lat = lat_in[j1+1]; + for(l2=0; l2=ur_lat) && (y_in[1]>=ur_lat) + && (y_in[2]>=ur_lat) && (y_in[3]>=ur_lat) ) continue; + + x_in[0] = lon_out[l2*nv]; + x_in[1] = lon_out[l2*nv+1]; + x_in[2] = lon_out[l2*nv+2]; + x_in[3] = lon_out[l2*nv+3]; + n_in = fix_lon(x_in, y_in, 4, (ll_lon+ur_lon)/2); + + if ( (n_out = clip ( x_in, y_in, n_in, ll_lon, ll_lat, ur_lon, ur_lat, x_out, y_out )) > 0 ) { + Xarea = poly_area (x_out, y_out, n_out ) * mask_in[j1*nx1+i1]; + min_area = min(area_in[j1*nx1+i1], area_out[l2]); + if( Xarea/min_area > AREA_RATIO_THRESH ) { + xgrid_area[nxgrid] = Xarea; + i_in[nxgrid] = i1; + j_in[nxgrid] = j1; + l_out[nxgrid] = l2; + ++nxgrid; + if(nxgrid > MAXXGRID) error_handler("nxgrid is greater than MAXXGRID, increase MAXXGRID"); + } + } + } + } + + free(area_in); + free(area_out); + + return nxgrid; + +} /* create_xgrid_1dx2d_order1_ug */ + +/******************************************************************************** + void create_xgrid_1dx2d_order2 + This routine generate exchange grids between two grids for the second order + conservative interpolation. nlon_in,nlat_in,nlon_out,nlat_out are the size of the grid cell + and lon_in,lat_in are 1-D grid bounds, lon_out,lat_out are geographic grid location of grid cell bounds. +********************************************************************************/ +int create_xgrid_1dx2d_order2_(const int *nlon_in, const int *nlat_in, const int *nlon_out, const int *nlat_out, + const double *lon_in, const double *lat_in, const double *lon_out, const double *lat_out, + const double *mask_in, int *i_in, int *j_in, int *i_out, int *j_out, + double *xgrid_area, double *xgrid_clon, double *xgrid_clat) +{ + int nxgrid; + nxgrid = create_xgrid_1dx2d_order2(nlon_in, nlat_in, nlon_out, nlat_out, lon_in, lat_in, lon_out, lat_out, mask_in, i_in, + j_in, i_out, j_out, xgrid_area, xgrid_clon, xgrid_clat); + return nxgrid; + +} +int create_xgrid_1dx2d_order2(const int *nlon_in, const int *nlat_in, const int *nlon_out, const int *nlat_out, + const double *lon_in, const double *lat_in, const double *lon_out, const double *lat_out, + const double *mask_in, int *i_in, int *j_in, int *i_out, int *j_out, + double *xgrid_area, double *xgrid_clon, double *xgrid_clat) +{ + + int nx1, ny1, nx2, ny2, nx1p, nx2p; + int i1, j1, i2, j2, nxgrid; + double ll_lon, ll_lat, ur_lon, ur_lat, x_in[MV], y_in[MV], x_out[MV], y_out[MV]; + double *area_in, *area_out, min_area; + double *tmpx, *tmpy; + + nx1 = *nlon_in; + ny1 = *nlat_in; + nx2 = *nlon_out; + ny2 = *nlat_out; + + nxgrid = 0; + nx1p = nx1 + 1; + nx2p = nx2 + 1; + + area_in = (double *)malloc(nx1*ny1*sizeof(double)); + area_out = (double *)malloc(nx2*ny2*sizeof(double)); + tmpx = (double *)malloc((nx1+1)*(ny1+1)*sizeof(double)); + tmpy = (double *)malloc((nx1+1)*(ny1+1)*sizeof(double)); + for(j1=0; j1<=ny1; j1++) for(i1=0; i1<=nx1; i1++) { + tmpx[j1*nx1p+i1] = lon_in[i1]; + tmpy[j1*nx1p+i1] = lat_in[j1]; + } + get_grid_area(nlon_in, nlat_in, tmpx, tmpy, area_in); + get_grid_area(nlon_out, nlat_out, lon_out, lat_out, area_out); + free(tmpx); + free(tmpy); + + for(j1=0; j1 MASK_THRESH ) { + + ll_lon = lon_in[i1]; ll_lat = lat_in[j1]; + ur_lon = lon_in[i1+1]; ur_lat = lat_in[j1+1]; + for(j2=0; j2=ur_lat) && (y_in[1]>=ur_lat) + && (y_in[2]>=ur_lat) && (y_in[3]>=ur_lat) ) continue; + + x_in[0] = lon_out[j2*nx2p+i2]; + x_in[1] = lon_out[j2*nx2p+i2+1]; + x_in[2] = lon_out[(j2+1)*nx2p+i2+1]; + x_in[3] = lon_out[(j2+1)*nx2p+i2]; + n_in = fix_lon(x_in, y_in, 4, (ll_lon+ur_lon)/2); + lon_in_avg = avgval_double(n_in, x_in); + + if ( (n_out = clip ( x_in, y_in, n_in, ll_lon, ll_lat, ur_lon, ur_lat, x_out, y_out )) > 0 ) { + xarea = poly_area (x_out, y_out, n_out ) * mask_in[j1*nx1+i1]; + min_area = min(area_in[j1*nx1+i1], area_out[j2*nx2+i2]); + if(xarea/min_area > AREA_RATIO_THRESH ) { + xgrid_area[nxgrid] = xarea; + xgrid_clon[nxgrid] = poly_ctrlon(x_out, y_out, n_out, lon_in_avg); + xgrid_clat[nxgrid] = poly_ctrlat (x_out, y_out, n_out ); + i_in[nxgrid] = i1; + j_in[nxgrid] = j1; + i_out[nxgrid] = i2; + j_out[nxgrid] = j2; + ++nxgrid; + if(nxgrid > MAXXGRID) error_handler("nxgrid is greater than MAXXGRID, increase MAXXGRID"); + } + } + } + } + free(area_in); + free(area_out); + + return nxgrid; + +} /* create_xgrid_1dx2d_order2 */ + +/******************************************************************************* + void create_xgrid_2dx1d_order1 + This routine generate exchange grids between two grids for the first order + conservative interpolation. nlon_in,nlat_in,nlon_out,nlat_out are the size of the grid cell + and lon_out,lat_out are 1-D grid bounds, lon_in,lat_in are geographic grid location of grid cell bounds. + mask is on grid lon_in/lat_in. +*******************************************************************************/ +int create_xgrid_2dx1d_order1_(const int *nlon_in, const int *nlat_in, const int *nlon_out, const int *nlat_out, + const double *lon_in, const double *lat_in, const double *lon_out, const double *lat_out, + const double *mask_in, int *i_in, int *j_in, int *i_out, + int *j_out, double *xgrid_area) +{ + int nxgrid; + + nxgrid = create_xgrid_2dx1d_order1(nlon_in, nlat_in, nlon_out, nlat_out, lon_in, lat_in, lon_out, lat_out, mask_in, + i_in, j_in, i_out, j_out, xgrid_area); + return nxgrid; + +} +int create_xgrid_2dx1d_order1(const int *nlon_in, const int *nlat_in, const int *nlon_out, const int *nlat_out, const double *lon_in, + const double *lat_in, const double *lon_out, const double *lat_out, + const double *mask_in, int *i_in, int *j_in, int *i_out, + int *j_out, double *xgrid_area) +{ + + int nx1, ny1, nx2, ny2, nx1p, nx2p; + int i1, j1, i2, j2, nxgrid; + double ll_lon, ll_lat, ur_lon, ur_lat, x_in[MV], y_in[MV], x_out[MV], y_out[MV]; + double *area_in, *area_out, min_area; + double *tmpx, *tmpy; + int n_in, n_out; + double Xarea; + + + nx1 = *nlon_in; + ny1 = *nlat_in; + nx2 = *nlon_out; + ny2 = *nlat_out; + + nxgrid = 0; + nx1p = nx1 + 1; + nx2p = nx2 + 1; + area_in = (double *)malloc(nx1*ny1*sizeof(double)); + area_out = (double *)malloc(nx2*ny2*sizeof(double)); + tmpx = (double *)malloc((nx2+1)*(ny2+1)*sizeof(double)); + tmpy = (double *)malloc((nx2+1)*(ny2+1)*sizeof(double)); + for(j2=0; j2<=ny2; j2++) for(i2=0; i2<=nx2; i2++) { + tmpx[j2*nx2p+i2] = lon_out[i2]; + tmpy[j2*nx2p+i2] = lat_out[j2]; + } + get_grid_area(nlon_in, nlat_in, lon_in, lat_in, area_in); + get_grid_area(nlon_out, nlat_out, tmpx, tmpy, area_out); + + free(tmpx); + free(tmpy); + + for(j2=0; j2 MASK_THRESH ) { + + y_in[0] = lat_in[j1*nx1p+i1]; + y_in[1] = lat_in[j1*nx1p+i1+1]; + y_in[2] = lat_in[(j1+1)*nx1p+i1+1]; + y_in[3] = lat_in[(j1+1)*nx1p+i1]; + if ( (y_in[0]<=ll_lat) && (y_in[1]<=ll_lat) + && (y_in[2]<=ll_lat) && (y_in[3]<=ll_lat) ) continue; + if ( (y_in[0]>=ur_lat) && (y_in[1]>=ur_lat) + && (y_in[2]>=ur_lat) && (y_in[3]>=ur_lat) ) continue; + + x_in[0] = lon_in[j1*nx1p+i1]; + x_in[1] = lon_in[j1*nx1p+i1+1]; + x_in[2] = lon_in[(j1+1)*nx1p+i1+1]; + x_in[3] = lon_in[(j1+1)*nx1p+i1]; + + n_in = fix_lon(x_in, y_in, 4, (ll_lon+ur_lon)/2); + + if ( (n_out = clip ( x_in, y_in, n_in, ll_lon, ll_lat, ur_lon, ur_lat, x_out, y_out )) > 0 ) { + Xarea = poly_area ( x_out, y_out, n_out ) * mask_in[j1*nx1+i1]; + min_area = min(area_in[j1*nx1+i1], area_out[j2*nx2+i2]); + if( Xarea/min_area > AREA_RATIO_THRESH ) { + xgrid_area[nxgrid] = Xarea; + i_in[nxgrid] = i1; + j_in[nxgrid] = j1; + i_out[nxgrid] = i2; + j_out[nxgrid] = j2; + ++nxgrid; + if(nxgrid > MAXXGRID) error_handler("nxgrid is greater than MAXXGRID, increase MAXXGRID"); + } + } + } + } + + free(area_in); + free(area_out); + + return nxgrid; + +} /* create_xgrid_2dx1d_order1 */ + + +/******************************************************************************** + void create_xgrid_2dx1d_order2 + This routine generate exchange grids between two grids for the second order + conservative interpolation. nlon_in,nlat_in,nlon_out,nlat_out are the size of the grid cell + and lon_out,lat_out are 1-D grid bounds, lon_in,lat_in are geographic grid location of grid cell bounds. + mask is on grid lon_in/lat_in. +********************************************************************************/ +int create_xgrid_2dx1d_order2_(const int *nlon_in, const int *nlat_in, const int *nlon_out, const int *nlat_out, + const double *lon_in, const double *lat_in, const double *lon_out, const double *lat_out, + const double *mask_in, int *i_in, int *j_in, int *i_out, int *j_out, + double *xgrid_area, double *xgrid_clon, double *xgrid_clat) +{ + int nxgrid; + nxgrid = create_xgrid_2dx1d_order2(nlon_in, nlat_in, nlon_out, nlat_out, lon_in, lat_in, lon_out, lat_out, mask_in, i_in, + j_in, i_out, j_out, xgrid_area, xgrid_clon, xgrid_clat); + return nxgrid; + +} + +int create_xgrid_2dx1d_order2(const int *nlon_in, const int *nlat_in, const int *nlon_out, const int *nlat_out, + const double *lon_in, const double *lat_in, const double *lon_out, const double *lat_out, + const double *mask_in, int *i_in, int *j_in, int *i_out, int *j_out, + double *xgrid_area, double *xgrid_clon, double *xgrid_clat) +{ + + int nx1, ny1, nx2, ny2, nx1p, nx2p; + int i1, j1, i2, j2, nxgrid; + double ll_lon, ll_lat, ur_lon, ur_lat, x_in[MV], y_in[MV], x_out[MV], y_out[MV]; + double *tmpx, *tmpy; + double *area_in, *area_out, min_area; + double lon_in_avg; + int n_in, n_out; + double xarea; + + + nx1 = *nlon_in; + ny1 = *nlat_in; + nx2 = *nlon_out; + ny2 = *nlat_out; + + nxgrid = 0; + nx1p = nx1 + 1; + nx2p = nx2 + 1; + + area_in = (double *)malloc(nx1*ny1*sizeof(double)); + area_out = (double *)malloc(nx2*ny2*sizeof(double)); + tmpx = (double *)malloc((nx2+1)*(ny2+1)*sizeof(double)); + tmpy = (double *)malloc((nx2+1)*(ny2+1)*sizeof(double)); + for(j2=0; j2<=ny2; j2++) for(i2=0; i2<=nx2; i2++) { + tmpx[j2*nx2p+i2] = lon_out[i2]; + tmpy[j2*nx2p+i2] = lat_out[j2]; + } + get_grid_area(nlon_in, nlat_in, lon_in, lat_in, area_in); + get_grid_area(nlon_out, nlat_out, tmpx, tmpy, area_out); + + free(tmpx); + free(tmpy); + + for(j2=0; j2 MASK_THRESH ) { + + y_in[0] = lat_in[j1*nx1p+i1]; + y_in[1] = lat_in[j1*nx1p+i1+1]; + y_in[2] = lat_in[(j1+1)*nx1p+i1+1]; + y_in[3] = lat_in[(j1+1)*nx1p+i1]; + if ( (y_in[0]<=ll_lat) && (y_in[1]<=ll_lat) + && (y_in[2]<=ll_lat) && (y_in[3]<=ll_lat) ) continue; + if ( (y_in[0]>=ur_lat) && (y_in[1]>=ur_lat) + && (y_in[2]>=ur_lat) && (y_in[3]>=ur_lat) ) continue; + + x_in[0] = lon_in[j1*nx1p+i1]; + x_in[1] = lon_in[j1*nx1p+i1+1]; + x_in[2] = lon_in[(j1+1)*nx1p+i1+1]; + x_in[3] = lon_in[(j1+1)*nx1p+i1]; + + n_in = fix_lon(x_in, y_in, 4, (ll_lon+ur_lon)/2); + lon_in_avg = avgval_double(n_in, x_in); + + if ( (n_out = clip ( x_in, y_in, n_in, ll_lon, ll_lat, ur_lon, ur_lat, x_out, y_out )) > 0 ) { + xarea = poly_area (x_out, y_out, n_out ) * mask_in[j1*nx1+i1]; + min_area = min(area_in[j1*nx1+i1], area_out[j2*nx2+i2]); + if(xarea/min_area > AREA_RATIO_THRESH ) { + xgrid_area[nxgrid] = xarea; + xgrid_clon[nxgrid] = poly_ctrlon(x_out, y_out, n_out, lon_in_avg); + xgrid_clat[nxgrid] = poly_ctrlat (x_out, y_out, n_out ); + i_in[nxgrid] = i1; + j_in[nxgrid] = j1; + i_out[nxgrid] = i2; + j_out[nxgrid] = j2; + ++nxgrid; + if(nxgrid > MAXXGRID) error_handler("nxgrid is greater than MAXXGRID, increase MAXXGRID"); + } + } + } + } + + free(area_in); + free(area_out); + + return nxgrid; + +} /* create_xgrid_2dx1d_order2 */ + +/******************************************************************************* + void create_xgrid_2DX2D_order1 + This routine generate exchange grids between two grids for the first order + conservative interpolation. nlon_in,nlat_in,nlon_out,nlat_out are the size of the grid cell + and lon_in,lat_in, lon_out,lat_out are geographic grid location of grid cell bounds. + mask is on grid lon_in/lat_in. +*******************************************************************************/ +int create_xgrid_2dx2d_order1_(const int *nlon_in, const int *nlat_in, const int *nlon_out, const int *nlat_out, + const double *lon_in, const double *lat_in, const double *lon_out, const double *lat_out, + const double *mask_in, int *i_in, int *j_in, int *i_out, + int *j_out, double *xgrid_area) +{ + int nxgrid; + + nxgrid = create_xgrid_2dx2d_order1(nlon_in, nlat_in, nlon_out, nlat_out, lon_in, lat_in, lon_out, lat_out, mask_in, + i_in, j_in, i_out, j_out, xgrid_area); + return nxgrid; + +} +int create_xgrid_2dx2d_order1(const int *nlon_in, const int *nlat_in, const int *nlon_out, const int *nlat_out, + const double *lon_in, const double *lat_in, const double *lon_out, const double *lat_out, + const double *mask_in, int *i_in, int *j_in, int *i_out, + int *j_out, double *xgrid_area) +{ + + int nx1, nx2, ny1, ny2, nx1p, nx2p, nxgrid; + double *area_in, *area_out; + int nblocks =1; + int *istart2=NULL, *iend2=NULL; + int npts_left, nblks_left, pos, m, npts_my, ij; + double *lon_out_min_list,*lon_out_max_list,*lon_out_avg,*lat_out_min_list,*lat_out_max_list; + double *lon_out_list, *lat_out_list; + int *pnxgrid=NULL, *pstart; + int *pi_in=NULL, *pj_in=NULL, *pi_out=NULL, *pj_out=NULL; + double *pxgrid_area=NULL; + int *n2_list; + int nthreads, nxgrid_block_max; + + nx1 = *nlon_in; + ny1 = *nlat_in; + nx2 = *nlon_out; + ny2 = *nlat_out; + nx1p = nx1 + 1; + nx2p = nx2 + 1; + + area_in = (double *)malloc(nx1*ny1*sizeof(double)); + area_out = (double *)malloc(nx2*ny2*sizeof(double)); + get_grid_area(nlon_in, nlat_in, lon_in, lat_in, area_in); + get_grid_area(nlon_out, nlat_out, lon_out, lat_out, area_out); + + nthreads = 1; +#if defined(_OPENMP) +#pragma omp parallel + nthreads = omp_get_num_threads(); +#endif + + nblocks = nthreads; + + istart2 = (int *)malloc(nblocks*sizeof(int)); + iend2 = (int *)malloc(nblocks*sizeof(int)); + + pstart = (int *)malloc(nblocks*sizeof(int)); + pnxgrid = (int *)malloc(nblocks*sizeof(int)); + + nxgrid_block_max = MAXXGRID/nblocks; + + for(m=0; m MAX_V) error_handler("create_xgrid.c: n2_in is greater than MAX_V"); + lon_out_min_list[n] = minval_double(n2_in, x2_in); + lon_out_max_list[n] = maxval_double(n2_in, x2_in); + lon_out_avg[n] = avgval_double(n2_in, x2_in); + n2_list[n] = n2_in; + for(l=0; l MASK_THRESH ) { + int n0, n1, n2, n3, l,n1_in; + double lat_in_min,lat_in_max,lon_in_min,lon_in_max,lon_in_avg; + double x1_in[MV], y1_in[MV], x_out[MV], y_out[MV]; + + n0 = j1*nx1p+i1; n1 = j1*nx1p+i1+1; + n2 = (j1+1)*nx1p+i1+1; n3 = (j1+1)*nx1p+i1; + x1_in[0] = lon_in[n0]; y1_in[0] = lat_in[n0]; + x1_in[1] = lon_in[n1]; y1_in[1] = lat_in[n1]; + x1_in[2] = lon_in[n2]; y1_in[2] = lat_in[n2]; + x1_in[3] = lon_in[n3]; y1_in[3] = lat_in[n3]; + lat_in_min = minval_double(4, y1_in); + lat_in_max = maxval_double(4, y1_in); + n1_in = fix_lon(x1_in, y1_in, 4, M_PI); + lon_in_min = minval_double(n1_in, x1_in); + lon_in_max = maxval_double(n1_in, x1_in); + lon_in_avg = avgval_double(n1_in, x1_in); + for(ij=istart2[m]; ij<=iend2[m]; ij++) { + int n_out, i2, j2, n2_in; + double xarea, dx, lon_out_min, lon_out_max; + double x2_in[MAX_V], y2_in[MAX_V]; + + i2 = ij%nx2; + j2 = ij/nx2; + + if(lat_out_min_list[ij] >= lat_in_max || lat_out_max_list[ij] <= lat_in_min ) continue; + /* adjust x2_in according to lon_in_avg*/ + n2_in = n2_list[ij]; + for(l=0; l M_PI) { + lon_out_min -= TPI; + lon_out_max -= TPI; + for (l=0; l= lon_in_max || lon_out_max <= lon_in_min ) continue; + if ( (n_out = clip_2dx2d( x1_in, y1_in, n1_in, x2_in, y2_in, n2_in, x_out, y_out )) > 0) { + double min_area; + int nn; + xarea = poly_area (x_out, y_out, n_out ) * mask_in[j1*nx1+i1]; + min_area = min(area_in[j1*nx1+i1], area_out[j2*nx2+i2]); + if( xarea/min_area > AREA_RATIO_THRESH ) { + pnxgrid[m]++; + if(pnxgrid[m]>= MAXXGRID/nthreads) + error_handler("nxgrid is greater than MAXXGRID/nthreads, increase MAXXGRID, decrease nthreads, or increase number of MPI ranks"); + nn = pstart[m] + pnxgrid[m]-1; + + pxgrid_area[nn] = xarea; + pi_in[nn] = i1; + pj_in[nn] = j1; + pi_out[nn] = i2; + pj_out[nn] = j2; + } + + } + + } + } + } + + /*copy data if nblocks > 1 */ + if(nblocks == 1) { + nxgrid = pnxgrid[0]; + pi_in = NULL; + pj_in = NULL; + pi_out = NULL; + pj_out = NULL; + pxgrid_area = NULL; + } + else { + int nn, i; + nxgrid = 0; + for(m=0; m MAX_V) error_handler("create_xgrid.c: n2_in is greater than MAX_V"); + lon_out_min_list[n] = minval_double(n2_in, x2_in); + lon_out_max_list[n] = maxval_double(n2_in, x2_in); + lon_out_avg[n] = avgval_double(n2_in, x2_in); + n2_list[n] = n2_in; + for(l=0; l MASK_THRESH ) { + int n0, n1, n2, n3, l,n1_in; + double lat_in_min,lat_in_max,lon_in_min,lon_in_max,lon_in_avg; + double x1_in[MV], y1_in[MV], x_out[MV], y_out[MV]; + + n0 = j1*nx1p+i1; n1 = j1*nx1p+i1+1; + n2 = (j1+1)*nx1p+i1+1; n3 = (j1+1)*nx1p+i1; + x1_in[0] = lon_in[n0]; y1_in[0] = lat_in[n0]; + x1_in[1] = lon_in[n1]; y1_in[1] = lat_in[n1]; + x1_in[2] = lon_in[n2]; y1_in[2] = lat_in[n2]; + x1_in[3] = lon_in[n3]; y1_in[3] = lat_in[n3]; + lat_in_min = minval_double(4, y1_in); + lat_in_max = maxval_double(4, y1_in); + n1_in = fix_lon(x1_in, y1_in, 4, M_PI); + lon_in_min = minval_double(n1_in, x1_in); + lon_in_max = maxval_double(n1_in, x1_in); + lon_in_avg = avgval_double(n1_in, x1_in); + for(ij=istart2[m]; ij<=iend2[m]; ij++) { + int n_out, i2, j2, n2_in; + double xarea, dx, lon_out_min, lon_out_max; + double x2_in[MAX_V], y2_in[MAX_V]; + + i2 = ij%nx2; + j2 = ij/nx2; + + if(lat_out_min_list[ij] >= lat_in_max || lat_out_max_list[ij] <= lat_in_min ) continue; + /* adjust x2_in according to lon_in_avg*/ + n2_in = n2_list[ij]; + for(l=0; l M_PI) { + lon_out_min -= TPI; + lon_out_max -= TPI; + for (l=0; l= lon_in_max || lon_out_max <= lon_in_min ) continue; + if ( (n_out = clip_2dx2d( x1_in, y1_in, n1_in, x2_in, y2_in, n2_in, x_out, y_out )) > 0) { + double min_area; + int nn; + xarea = poly_area (x_out, y_out, n_out ) * mask_in[j1*nx1+i1]; + min_area = min(area_in[j1*nx1+i1], area_out[j2*nx2+i2]); + if( xarea/min_area > AREA_RATIO_THRESH ) { + pnxgrid[m]++; + if(pnxgrid[m]>= MAXXGRID/nthreads) + error_handler("nxgrid is greater than MAXXGRID/nthreads, increase MAXXGRID, decrease nthreads, or increase number of MPI ranks"); + nn = pstart[m] + pnxgrid[m]-1; + pxgrid_area[nn] = xarea; + pxgrid_clon[nn] = poly_ctrlon(x_out, y_out, n_out, lon_in_avg); + pxgrid_clat[nn] = poly_ctrlat (x_out, y_out, n_out ); + pi_in[nn] = i1; + pj_in[nn] = j1; + pi_out[nn] = i2; + pj_out[nn] = j2; + } + } + } + } + } + + /*copy data if nblocks > 1 */ + if(nblocks == 1) { + nxgrid = pnxgrid[0]; + pi_in = NULL; + pj_in = NULL; + pi_out = NULL; + pj_out = NULL; + pxgrid_area = NULL; + pxgrid_clon = NULL; + pxgrid_clat = NULL; + } + else { + int nn, i; + nxgrid = 0; + for(m=0; m MASK_THRESH ) { + /* clockwise */ + n0 = j1*nx1p+i1; n1 = (j1+1)*nx1p+i1; + n2 = (j1+1)*nx1p+i1+1; n3 = j1*nx1p+i1+1; + x1_in[0] = x1[n0]; y1_in[0] = y1[n0]; z1_in[0] = z1[n0]; + x1_in[1] = x1[n1]; y1_in[1] = y1[n1]; z1_in[1] = z1[n1]; + x1_in[2] = x1[n2]; y1_in[2] = y1[n2]; z1_in[2] = z1[n2]; + x1_in[3] = x1[n3]; y1_in[3] = y1[n3]; z1_in[3] = z1[n3]; + + for(j2=0; j2 0) { + xarea = great_circle_area ( n_out, x_out, y_out, z_out ) * mask_in[j1*nx1+i1]; + min_area = min(area1[j1*nx1+i1], area2[j2*nx2+i2]); + if( xarea/min_area > AREA_RATIO_THRESH ) { + xgrid_area[nxgrid] = xarea; + xgrid_clon[nxgrid] = 0; /*z1l: will be developed very soon */ + xgrid_clat[nxgrid] = 0; + i_in[nxgrid] = i1; + j_in[nxgrid] = j1; + i_out[nxgrid] = i2; + j_out[nxgrid] = j2; + ++nxgrid; + if(nxgrid > MAXXGRID) error_handler("nxgrid is greater than MAXXGRID, increase MAXXGRID"); + } + } + } + } + + + free(area1); + free(area2); + + free(x1); + free(y1); + free(z1); + free(x2); + free(y2); + free(z2); + + return nxgrid; + +}/* create_xgrid_great_circle */ + +int create_xgrid_great_circle_ug_(const int *nlon_in, const int *nlat_in, const int *npts_out, + const double *lon_in, const double *lat_in, const double *lon_out, const double *lat_out, + const double *mask_in, int *i_in, int *j_in, int *l_out, + double *xgrid_area, double *xgrid_clon, double *xgrid_clat) +{ + int nxgrid; + nxgrid = create_xgrid_great_circle_ug(nlon_in, nlat_in, npts_out, lon_in, lat_in, lon_out, lat_out, + mask_in, i_in, j_in, l_out, xgrid_area, xgrid_clon, xgrid_clat); + + return nxgrid; +} + +int create_xgrid_great_circle_ug(const int *nlon_in, const int *nlat_in, const int *npts_out, + const double *lon_in, const double *lat_in, const double *lon_out, const double *lat_out, + const double *mask_in, int *i_in, int *j_in, int *l_out, + double *xgrid_area, double *xgrid_clon, double *xgrid_clat) +{ + + int nx1, ny1, npts2, nx1p, ny1p, nxgrid, n1_in, n2_in, nv; + int n0, n1, n2, n3, i1, j1, l2; + double x1_in[MV], y1_in[MV], z1_in[MV]; + double x2_in[MV], y2_in[MV], z2_in[MV]; + double x_out[MV], y_out[MV], z_out[MV]; + double *x1=NULL, *y1=NULL, *z1=NULL; + double *x2=NULL, *y2=NULL, *z2=NULL; + + double *area1, *area2, min_area; + + nx1 = *nlon_in; + ny1 = *nlat_in; + nv = 4; + npts2 = *npts_out; + nxgrid = 0; + nx1p = nx1 + 1; + ny1p = ny1 + 1; + + /* first convert lon-lat to cartesian coordinates */ + x1 = (double *)malloc(nx1p*ny1p*sizeof(double)); + y1 = (double *)malloc(nx1p*ny1p*sizeof(double)); + z1 = (double *)malloc(nx1p*ny1p*sizeof(double)); + x2 = (double *)malloc(npts2*nv*sizeof(double)); + y2 = (double *)malloc(npts2*nv*sizeof(double)); + z2 = (double *)malloc(npts2*nv*sizeof(double)); + + latlon2xyz(nx1p*ny1p, lon_in, lat_in, x1, y1, z1); + latlon2xyz(npts2*nv, lon_out, lat_out, x2, y2, z2); + + area1 = (double *)malloc(nx1*ny1*sizeof(double)); + area2 = (double *)malloc(npts2*sizeof(double)); + get_grid_great_circle_area(nlon_in, nlat_in, lon_in, lat_in, area1); + get_grid_great_circle_area_ug(npts_out, lon_out, lat_out, area2); + n1_in = 4; + n2_in = 4; + + for(j1=0; j1 MASK_THRESH ) { + /* clockwise */ + n0 = j1*nx1p+i1; n1 = (j1+1)*nx1p+i1; + n2 = (j1+1)*nx1p+i1+1; n3 = j1*nx1p+i1+1; + x1_in[0] = x1[n0]; y1_in[0] = y1[n0]; z1_in[0] = z1[n0]; + x1_in[1] = x1[n1]; y1_in[1] = y1[n1]; z1_in[1] = z1[n1]; + x1_in[2] = x1[n2]; y1_in[2] = y1[n2]; z1_in[2] = z1[n2]; + x1_in[3] = x1[n3]; y1_in[3] = y1[n3]; z1_in[3] = z1[n3]; + + for(l2=0; l2 0) { + xarea = great_circle_area ( n_out, x_out, y_out, z_out ) * mask_in[j1*nx1+i1]; + min_area = min(area1[j1*nx1+i1], area2[l2]); + if( xarea/min_area > AREA_RATIO_THRESH ) { + xgrid_area[nxgrid] = xarea; + xgrid_clon[nxgrid] = 0; /*z1l: will be developed very soon */ + xgrid_clat[nxgrid] = 0; + i_in[nxgrid] = i1; + j_in[nxgrid] = j1; + l_out[nxgrid] = l2; + ++nxgrid; + if(nxgrid > MAXXGRID) error_handler("nxgrid is greater than MAXXGRID, increase MAXXGRID"); + } + } + } + } + + + free(area1); + free(area2); + + free(x1); + free(y1); + free(z1); + free(x2); + free(y2); + free(z2); + + return nxgrid; + +}/* create_xgrid_great_circle_ug */ + +/******************************************************************************* + int get_maxxgrid + return constants MAXXGRID. +*******************************************************************************/ +int get_maxxgrid(void) +{ + return MAXXGRID; +} + +int get_maxxgrid_(void) +{ + return get_maxxgrid(); +} diff --git a/mosaic/create_xgrid.h b/horiz_interp/include/horiz_interp_conserve_xgrid.h similarity index 74% rename from mosaic/create_xgrid.h rename to horiz_interp/include/horiz_interp_conserve_xgrid.h index 90c0338b93..4711723357 100644 --- a/mosaic/create_xgrid.h +++ b/horiz_interp/include/horiz_interp_conserve_xgrid.h @@ -16,52 +16,16 @@ * You should have received a copy of the GNU Lesser General Public * License along with FMS. If not, see . **********************************************************************/ -#ifndef CREATE_XGRID_H_ -#define CREATE_XGRID_H_ +#ifndef HORIZ_INTERP_CREATE_XGRID_H_ +#define HORIZ_INTERP_CREATE_XGRID_H_ #ifndef MAXXGRID #define MAXXGRID 1e6 #endif -#define MV 50 -/* this value is small compare to earth area */ - -double grid_box_radius(const double *x, const double *y, const double *z, int n); - -double dist_between_boxes(const double *x1, const double *y1, const double *z1, int n1, - const double *x2, const double *y2, const double *z2, int n2); - -int inside_edge(double x0, double y0, double x1, double y1, double x, double y); - -int line_intersect_2D_3D(double *a1, double *a2, double *q1, double *q2, double *q3, - double *intersect, double *u_a, double *u_q, int *inbound); - -double poly_ctrlon(const double lon[], const double lat[], int n, double clon); - -double poly_ctrlat(const double lon[], const double lat[], int n); - -double box_ctrlon(double ll_lon, double ll_lat, double ur_lon, double ur_lat, double clon); - -double box_ctrlat(double ll_lon, double ll_lat, double ur_lon, double ur_lat); - -int get_maxxgrid(void); - -int get_maxxgrid_(void); - -void get_grid_area(const int *nlon, const int *nlat, const double *lon, const double *lat, double *area); - -void get_grid_great_circle_area(const int *nlon, const int *nlat, const double *lon, const double *lat, double *area); - -void get_grid_area_dimensionless(const int *nlon, const int *nlat, const double *lon, const double *lat, double *area); - -void get_grid_area_no_adjust(const int *nlon, const int *nlat, const double *lon, const double *lat, double *area); - -int clip(const double lon_in[], const double lat_in[], int n_in, double ll_lon, double ll_lat, - double ur_lon, double ur_lat, double lon_out[], double lat_out[]); - -int clip_2dx2d(const double lon1_in[], const double lat1_in[], int n1_in, - const double lon2_in[], const double lat2_in[], int n2_in, - double lon_out[], double lat_out[]); +#define AREA_RATIO_THRESH (1.e-6) +#define MASK_THRESH (0.5) +#define MAX_V 8 int create_xgrid_1dx2d_order1(const int *nlon_in, const int *nlat_in, const int *nlon_out, const int *nlat_out, const double *lon_in, const double *lat_in, const double *lon_out, const double *lat_out, @@ -112,29 +76,20 @@ int create_xgrid_2dx2d_order2(const int *nlon_in, const int *nlat_in, const int const double *mask_in, int *i_in, int *j_in, int *i_out, int *j_out, double *xgrid_area, double *xgrid_clon, double *xgrid_clat); -int clip_2dx2d_great_circle(const double x1_in[], const double y1_in[], const double z1_in[], int n1_in, - const double x2_in[], const double y2_in[], const double z2_in [], int n2_in, - double x_out[], double y_out[], double z_out[]); - int create_xgrid_great_circle(const int *nlon_in, const int *nlat_in, const int *nlon_out, const int *nlat_out, const double *lon_in, const double *lat_in, const double *lon_out, const double *lat_out, const double *mask_in, int *i_in, int *j_in, int *i_out, int *j_out, double *xgrid_area, double *xgrid_clon, double *xgrid_clat); -void get_grid_area_ug(const int *npts, const double *lon, const double *lat, double *area); int create_xgrid_1dx2d_order1_ug(const int *nlon_in, const int *nlat_in, const int *npts_out, const double *lon_in, const double *lat_in, const double *lon_out, const double *lat_out, const double *mask_in, int *i_in, int *j_in, int *l_out, double *xgrid_area); -void get_grid_great_circle_area_ug(const int *npts, const double *lon, const double *lat, double *area); + int create_xgrid_great_circle_ug(const int *nlon_in, const int *nlat_in, const int *npts_out, const double *lon_in, const double *lat_in, const double *lon_out, const double *lat_out, const double *mask_in, int *i_in, int *j_in, int *l_out, double *xgrid_area, double *xgrid_clon, double *xgrid_clat); -void get_grid_area_(const int *nlon, const int *nlat, const double *lon, const double *lat, double *area); - -void get_grid_great_circle_area_(const int *nlon, const int *nlat, const double *lon, const double *lat, double *area); - int create_xgrid_2dx2d_order1_(const int *nlon_in, const int *nlat_in, const int *nlon_out, const int *nlat_out, const double *lon_in, const double *lat_in, const double *lon_out, const double *lat_out, const double *mask_in, int *i_in, int *j_in, int *i_out, @@ -144,14 +99,17 @@ int create_xgrid_2dx2d_order2_(const int *nlon_in, const int *nlat_in, const int const double *lon_in, const double *lat_in, const double *lon_out, const double *lat_out, const double *mask_in, int *i_in, int *j_in, int *i_out, int *j_out, double *xgrid_area, double *xgrid_clon, double *xgrid_clat); -void get_grid_area_ug_(const int *npts, const double *lon, const double *lat, double *area); + int create_xgrid_1dx2d_order1_ug_(const int *nlon_in, const int *nlat_in, const int *npts_out, const double *lon_in, const double *lat_in, const double *lon_out, const double *lat_out, const double *mask_in, int *i_in, int *j_in, int *l_out, double *xgrid_area); -void get_grid_great_circle_area_ug_(const int *npts, const double *lon, const double *lat, double *area); + int create_xgrid_great_circle_ug_(const int *nlon_in, const int *nlat_in, const int *npts_out, const double *lon_in, const double *lat_in, const double *lon_out, const double *lat_out, const double *mask_in, int *i_in, int *j_in, int *l_out, double *xgrid_area, double *xgrid_clon, double *xgrid_clat); +int get_maxxgrid(void); +int get_maxxgrid_(void); + #endif diff --git a/libFMS/Makefile.am b/libFMS/Makefile.am index 91bf057e9a..f508b6c9f4 100644 --- a/libFMS/Makefile.am +++ b/libFMS/Makefile.am @@ -39,7 +39,7 @@ libFMS_la_LIBADD += $(top_builddir)/memutils/libmemutils.la libFMS_la_LIBADD += $(top_builddir)/fms/libfms.la libFMS_la_LIBADD += $(top_builddir)/fms2_io/libfms2_io.la libFMS_la_LIBADD += $(top_builddir)/affinity/libfms_affinity.la -libFMS_la_LIBADD += $(top_builddir)/mosaic/libmosaic.la +libFMS_la_LIBADD += $(top_builddir)/grid_utils/libgrid_utils.la libFMS_la_LIBADD += $(top_builddir)/mosaic2/libmosaic2.la libFMS_la_LIBADD += $(top_builddir)/coupler/libcoupler.la libFMS_la_LIBADD += $(top_builddir)/drifters/libdrifters.la diff --git a/mosaic/create_xgrid.c b/mosaic/create_xgrid.c deleted file mode 100644 index 7698303b92..0000000000 --- a/mosaic/create_xgrid.c +++ /dev/null @@ -1,3088 +0,0 @@ -/*********************************************************************** - * GNU Lesser General Public License - * - * This file is part of the GFDL Flexible Modeling System (FMS). - * - * FMS 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. - * - * FMS 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 Lesser General Public - * License along with FMS. If not, see . - **********************************************************************/ -#include -#include -#include -#include "mosaic_util.h" -#include "create_xgrid.h" -#include "constant.h" -#if defined(_OPENMP) -#include -#endif - -#define AREA_RATIO_THRESH (1.e-6) -#define MASK_THRESH (0.5) -#define EPSLN8 (1.e-8) -#define EPSLN30 (1.0e-30) -#define EPSLN10 (1.0e-10) -#define R2D (180/M_PI) -#define TPI (2.0*M_PI) - -/** \file - * \ingroup mosaic - * \brief Grid creation and calculation functions for use in @ref mosaic_mod - * / - -/******************************************************************************* - int get_maxxgrid - return constants MAXXGRID. -*******************************************************************************/ -int get_maxxgrid(void) -{ - return MAXXGRID; -} - -int get_maxxgrid_(void) -{ - return get_maxxgrid(); -} - - -/******************************************************************************* -void get_grid_area(const int *nlon, const int *nlat, const double *lon, const double *lat, const double *area) - return the grid area. -*******************************************************************************/ -void get_grid_area_(const int *nlon, const int *nlat, const double *lon, const double *lat, double *area) -{ - get_grid_area(nlon, nlat, lon, lat, area); -} - -void get_grid_area(const int *nlon, const int *nlat, const double *lon, const double *lat, double *area) -{ - int nx, ny, nxp, i, j, n_in; - double x_in[20], y_in[20]; - - nx = *nlon; - ny = *nlat; - nxp = nx + 1; - - for(j=0; j 1) - get_grid_area(nlon_in, nlat_in, tmpx, tmpy, area_in); - else - get_grid_area_no_adjust(nlon_in, nlat_in, tmpx, tmpy, area_in); - - get_grid_area(nlon_out, nlat_out, lon_out, lat_out, area_out); - free(tmpx); - free(tmpy); - - for(j1=0; j1 MASK_THRESH ) { - - ll_lon = lon_in[i1]; ll_lat = lat_in[j1]; - ur_lon = lon_in[i1+1]; ur_lat = lat_in[j1+1]; - for(j2=0; j2=ur_lat) && (y_in[1]>=ur_lat) - && (y_in[2]>=ur_lat) && (y_in[3]>=ur_lat) ) continue; - - x_in[0] = lon_out[j2*nx2p+i2]; - x_in[1] = lon_out[j2*nx2p+i2+1]; - x_in[2] = lon_out[(j2+1)*nx2p+i2+1]; - x_in[3] = lon_out[(j2+1)*nx2p+i2]; - n_in = fix_lon(x_in, y_in, 4, (ll_lon+ur_lon)/2); - - if ( (n_out = clip ( x_in, y_in, n_in, ll_lon, ll_lat, ur_lon, ur_lat, x_out, y_out )) > 0 ) { - Xarea = poly_area (x_out, y_out, n_out ) * mask_in[j1*nx1+i1]; - min_area = min(area_in[j1*nx1+i1], area_out[j2*nx2+i2]); - if( Xarea/min_area > AREA_RATIO_THRESH ) { - xgrid_area[nxgrid] = Xarea; - i_in[nxgrid] = i1; - j_in[nxgrid] = j1; - i_out[nxgrid] = i2; - j_out[nxgrid] = j2; - ++nxgrid; - if(nxgrid > MAXXGRID) error_handler("nxgrid is greater than MAXXGRID, increase MAXXGRID"); - } - } - } - } - - free(area_in); - free(area_out); - - return nxgrid; - -} /* create_xgrid_1dx2d_order1 */ - - -/******************************************************************************* - void create_xgrid_1dx2d_order1_ug - This routine generate exchange grids between two grids for the first order - conservative interpolation. nlon_in,nlat_in,nlon_out,nlat_out are the size of the grid cell - and lon_in,lat_in are 1-D grid bounds, lon_out,lat_out are geographic grid location of grid cell bounds. -*******************************************************************************/ -int create_xgrid_1dx2d_order1_ug_(const int *nlon_in, const int *nlat_in, const int *npts_out, - const double *lon_in, const double *lat_in, const double *lon_out, const double *lat_out, - const double *mask_in, int *i_in, int *j_in, int *l_out, double *xgrid_area) -{ - int nxgrid; - - nxgrid = create_xgrid_1dx2d_order1_ug(nlon_in, nlat_in, npts_out, lon_in, lat_in, lon_out, lat_out, mask_in, - i_in, j_in, l_out, xgrid_area); - return nxgrid; - -} - -int create_xgrid_1dx2d_order1_ug(const int *nlon_in, const int *nlat_in, const int *npts_out, const double *lon_in, - const double *lat_in, const double *lon_out, const double *lat_out, - const double *mask_in, int *i_in, int *j_in, int *l_out, double *xgrid_area) -{ - - int nx1, ny1, nx1p, nv, npts2; - int i1, j1, l2, nxgrid; - double ll_lon, ll_lat, ur_lon, ur_lat, x_in[MV], y_in[MV], x_out[MV], y_out[MV]; - double *area_in, *area_out, min_area; - double *tmpx, *tmpy; - - nx1 = *nlon_in; - ny1 = *nlat_in; - nv = 4; - npts2 = *npts_out; - - nxgrid = 0; - nx1p = nx1 + 1; - - area_in = (double *)malloc(nx1*ny1*sizeof(double)); - area_out = (double *)malloc(npts2*sizeof(double)); - tmpx = (double *)malloc((nx1+1)*(ny1+1)*sizeof(double)); - tmpy = (double *)malloc((nx1+1)*(ny1+1)*sizeof(double)); - for(j1=0; j1<=ny1; j1++) for(i1=0; i1<=nx1; i1++) { - tmpx[j1*nx1p+i1] = lon_in[i1]; - tmpy[j1*nx1p+i1] = lat_in[j1]; - } - /* This is just a temporary fix to solve the issue that there is one point in zonal direction */ - if(nx1 > 1) - get_grid_area(nlon_in, nlat_in, tmpx, tmpy, area_in); - else - get_grid_area_no_adjust(nlon_in, nlat_in, tmpx, tmpy, area_in); - - get_grid_area_ug(npts_out, lon_out, lat_out, area_out); - free(tmpx); - free(tmpy); - - for(j1=0; j1 MASK_THRESH ) { - - ll_lon = lon_in[i1]; ll_lat = lat_in[j1]; - ur_lon = lon_in[i1+1]; ur_lat = lat_in[j1+1]; - for(l2=0; l2=ur_lat) && (y_in[1]>=ur_lat) - && (y_in[2]>=ur_lat) && (y_in[3]>=ur_lat) ) continue; - - x_in[0] = lon_out[l2*nv]; - x_in[1] = lon_out[l2*nv+1]; - x_in[2] = lon_out[l2*nv+2]; - x_in[3] = lon_out[l2*nv+3]; - n_in = fix_lon(x_in, y_in, 4, (ll_lon+ur_lon)/2); - - if ( (n_out = clip ( x_in, y_in, n_in, ll_lon, ll_lat, ur_lon, ur_lat, x_out, y_out )) > 0 ) { - Xarea = poly_area (x_out, y_out, n_out ) * mask_in[j1*nx1+i1]; - min_area = min(area_in[j1*nx1+i1], area_out[l2]); - if( Xarea/min_area > AREA_RATIO_THRESH ) { - xgrid_area[nxgrid] = Xarea; - i_in[nxgrid] = i1; - j_in[nxgrid] = j1; - l_out[nxgrid] = l2; - ++nxgrid; - if(nxgrid > MAXXGRID) error_handler("nxgrid is greater than MAXXGRID, increase MAXXGRID"); - } - } - } - } - - free(area_in); - free(area_out); - - return nxgrid; - -} /* create_xgrid_1dx2d_order1_ug */ - -/******************************************************************************** - void create_xgrid_1dx2d_order2 - This routine generate exchange grids between two grids for the second order - conservative interpolation. nlon_in,nlat_in,nlon_out,nlat_out are the size of the grid cell - and lon_in,lat_in are 1-D grid bounds, lon_out,lat_out are geographic grid location of grid cell bounds. -********************************************************************************/ -int create_xgrid_1dx2d_order2_(const int *nlon_in, const int *nlat_in, const int *nlon_out, const int *nlat_out, - const double *lon_in, const double *lat_in, const double *lon_out, const double *lat_out, - const double *mask_in, int *i_in, int *j_in, int *i_out, int *j_out, - double *xgrid_area, double *xgrid_clon, double *xgrid_clat) -{ - int nxgrid; - nxgrid = create_xgrid_1dx2d_order2(nlon_in, nlat_in, nlon_out, nlat_out, lon_in, lat_in, lon_out, lat_out, mask_in, i_in, - j_in, i_out, j_out, xgrid_area, xgrid_clon, xgrid_clat); - return nxgrid; - -} -int create_xgrid_1dx2d_order2(const int *nlon_in, const int *nlat_in, const int *nlon_out, const int *nlat_out, - const double *lon_in, const double *lat_in, const double *lon_out, const double *lat_out, - const double *mask_in, int *i_in, int *j_in, int *i_out, int *j_out, - double *xgrid_area, double *xgrid_clon, double *xgrid_clat) -{ - - int nx1, ny1, nx2, ny2, nx1p, nx2p; - int i1, j1, i2, j2, nxgrid; - double ll_lon, ll_lat, ur_lon, ur_lat, x_in[MV], y_in[MV], x_out[MV], y_out[MV]; - double *area_in, *area_out, min_area; - double *tmpx, *tmpy; - - nx1 = *nlon_in; - ny1 = *nlat_in; - nx2 = *nlon_out; - ny2 = *nlat_out; - - nxgrid = 0; - nx1p = nx1 + 1; - nx2p = nx2 + 1; - - area_in = (double *)malloc(nx1*ny1*sizeof(double)); - area_out = (double *)malloc(nx2*ny2*sizeof(double)); - tmpx = (double *)malloc((nx1+1)*(ny1+1)*sizeof(double)); - tmpy = (double *)malloc((nx1+1)*(ny1+1)*sizeof(double)); - for(j1=0; j1<=ny1; j1++) for(i1=0; i1<=nx1; i1++) { - tmpx[j1*nx1p+i1] = lon_in[i1]; - tmpy[j1*nx1p+i1] = lat_in[j1]; - } - get_grid_area(nlon_in, nlat_in, tmpx, tmpy, area_in); - get_grid_area(nlon_out, nlat_out, lon_out, lat_out, area_out); - free(tmpx); - free(tmpy); - - for(j1=0; j1 MASK_THRESH ) { - - ll_lon = lon_in[i1]; ll_lat = lat_in[j1]; - ur_lon = lon_in[i1+1]; ur_lat = lat_in[j1+1]; - for(j2=0; j2=ur_lat) && (y_in[1]>=ur_lat) - && (y_in[2]>=ur_lat) && (y_in[3]>=ur_lat) ) continue; - - x_in[0] = lon_out[j2*nx2p+i2]; - x_in[1] = lon_out[j2*nx2p+i2+1]; - x_in[2] = lon_out[(j2+1)*nx2p+i2+1]; - x_in[3] = lon_out[(j2+1)*nx2p+i2]; - n_in = fix_lon(x_in, y_in, 4, (ll_lon+ur_lon)/2); - lon_in_avg = avgval_double(n_in, x_in); - - if ( (n_out = clip ( x_in, y_in, n_in, ll_lon, ll_lat, ur_lon, ur_lat, x_out, y_out )) > 0 ) { - xarea = poly_area (x_out, y_out, n_out ) * mask_in[j1*nx1+i1]; - min_area = min(area_in[j1*nx1+i1], area_out[j2*nx2+i2]); - if(xarea/min_area > AREA_RATIO_THRESH ) { - xgrid_area[nxgrid] = xarea; - xgrid_clon[nxgrid] = poly_ctrlon(x_out, y_out, n_out, lon_in_avg); - xgrid_clat[nxgrid] = poly_ctrlat (x_out, y_out, n_out ); - i_in[nxgrid] = i1; - j_in[nxgrid] = j1; - i_out[nxgrid] = i2; - j_out[nxgrid] = j2; - ++nxgrid; - if(nxgrid > MAXXGRID) error_handler("nxgrid is greater than MAXXGRID, increase MAXXGRID"); - } - } - } - } - free(area_in); - free(area_out); - - return nxgrid; - -} /* create_xgrid_1dx2d_order2 */ - -/******************************************************************************* - void create_xgrid_2dx1d_order1 - This routine generate exchange grids between two grids for the first order - conservative interpolation. nlon_in,nlat_in,nlon_out,nlat_out are the size of the grid cell - and lon_out,lat_out are 1-D grid bounds, lon_in,lat_in are geographic grid location of grid cell bounds. - mask is on grid lon_in/lat_in. -*******************************************************************************/ -int create_xgrid_2dx1d_order1_(const int *nlon_in, const int *nlat_in, const int *nlon_out, const int *nlat_out, - const double *lon_in, const double *lat_in, const double *lon_out, const double *lat_out, - const double *mask_in, int *i_in, int *j_in, int *i_out, - int *j_out, double *xgrid_area) -{ - int nxgrid; - - nxgrid = create_xgrid_2dx1d_order1(nlon_in, nlat_in, nlon_out, nlat_out, lon_in, lat_in, lon_out, lat_out, mask_in, - i_in, j_in, i_out, j_out, xgrid_area); - return nxgrid; - -} -int create_xgrid_2dx1d_order1(const int *nlon_in, const int *nlat_in, const int *nlon_out, const int *nlat_out, const double *lon_in, - const double *lat_in, const double *lon_out, const double *lat_out, - const double *mask_in, int *i_in, int *j_in, int *i_out, - int *j_out, double *xgrid_area) -{ - - int nx1, ny1, nx2, ny2, nx1p, nx2p; - int i1, j1, i2, j2, nxgrid; - double ll_lon, ll_lat, ur_lon, ur_lat, x_in[MV], y_in[MV], x_out[MV], y_out[MV]; - double *area_in, *area_out, min_area; - double *tmpx, *tmpy; - int n_in, n_out; - double Xarea; - - - nx1 = *nlon_in; - ny1 = *nlat_in; - nx2 = *nlon_out; - ny2 = *nlat_out; - - nxgrid = 0; - nx1p = nx1 + 1; - nx2p = nx2 + 1; - area_in = (double *)malloc(nx1*ny1*sizeof(double)); - area_out = (double *)malloc(nx2*ny2*sizeof(double)); - tmpx = (double *)malloc((nx2+1)*(ny2+1)*sizeof(double)); - tmpy = (double *)malloc((nx2+1)*(ny2+1)*sizeof(double)); - for(j2=0; j2<=ny2; j2++) for(i2=0; i2<=nx2; i2++) { - tmpx[j2*nx2p+i2] = lon_out[i2]; - tmpy[j2*nx2p+i2] = lat_out[j2]; - } - get_grid_area(nlon_in, nlat_in, lon_in, lat_in, area_in); - get_grid_area(nlon_out, nlat_out, tmpx, tmpy, area_out); - - free(tmpx); - free(tmpy); - - for(j2=0; j2 MASK_THRESH ) { - - y_in[0] = lat_in[j1*nx1p+i1]; - y_in[1] = lat_in[j1*nx1p+i1+1]; - y_in[2] = lat_in[(j1+1)*nx1p+i1+1]; - y_in[3] = lat_in[(j1+1)*nx1p+i1]; - if ( (y_in[0]<=ll_lat) && (y_in[1]<=ll_lat) - && (y_in[2]<=ll_lat) && (y_in[3]<=ll_lat) ) continue; - if ( (y_in[0]>=ur_lat) && (y_in[1]>=ur_lat) - && (y_in[2]>=ur_lat) && (y_in[3]>=ur_lat) ) continue; - - x_in[0] = lon_in[j1*nx1p+i1]; - x_in[1] = lon_in[j1*nx1p+i1+1]; - x_in[2] = lon_in[(j1+1)*nx1p+i1+1]; - x_in[3] = lon_in[(j1+1)*nx1p+i1]; - - n_in = fix_lon(x_in, y_in, 4, (ll_lon+ur_lon)/2); - - if ( (n_out = clip ( x_in, y_in, n_in, ll_lon, ll_lat, ur_lon, ur_lat, x_out, y_out )) > 0 ) { - Xarea = poly_area ( x_out, y_out, n_out ) * mask_in[j1*nx1+i1]; - min_area = min(area_in[j1*nx1+i1], area_out[j2*nx2+i2]); - if( Xarea/min_area > AREA_RATIO_THRESH ) { - xgrid_area[nxgrid] = Xarea; - i_in[nxgrid] = i1; - j_in[nxgrid] = j1; - i_out[nxgrid] = i2; - j_out[nxgrid] = j2; - ++nxgrid; - if(nxgrid > MAXXGRID) error_handler("nxgrid is greater than MAXXGRID, increase MAXXGRID"); - } - } - } - } - - free(area_in); - free(area_out); - - return nxgrid; - -} /* create_xgrid_2dx1d_order1 */ - - -/******************************************************************************** - void create_xgrid_2dx1d_order2 - This routine generate exchange grids between two grids for the second order - conservative interpolation. nlon_in,nlat_in,nlon_out,nlat_out are the size of the grid cell - and lon_out,lat_out are 1-D grid bounds, lon_in,lat_in are geographic grid location of grid cell bounds. - mask is on grid lon_in/lat_in. -********************************************************************************/ -int create_xgrid_2dx1d_order2_(const int *nlon_in, const int *nlat_in, const int *nlon_out, const int *nlat_out, - const double *lon_in, const double *lat_in, const double *lon_out, const double *lat_out, - const double *mask_in, int *i_in, int *j_in, int *i_out, int *j_out, - double *xgrid_area, double *xgrid_clon, double *xgrid_clat) -{ - int nxgrid; - nxgrid = create_xgrid_2dx1d_order2(nlon_in, nlat_in, nlon_out, nlat_out, lon_in, lat_in, lon_out, lat_out, mask_in, i_in, - j_in, i_out, j_out, xgrid_area, xgrid_clon, xgrid_clat); - return nxgrid; - -} - -int create_xgrid_2dx1d_order2(const int *nlon_in, const int *nlat_in, const int *nlon_out, const int *nlat_out, - const double *lon_in, const double *lat_in, const double *lon_out, const double *lat_out, - const double *mask_in, int *i_in, int *j_in, int *i_out, int *j_out, - double *xgrid_area, double *xgrid_clon, double *xgrid_clat) -{ - - int nx1, ny1, nx2, ny2, nx1p, nx2p; - int i1, j1, i2, j2, nxgrid; - double ll_lon, ll_lat, ur_lon, ur_lat, x_in[MV], y_in[MV], x_out[MV], y_out[MV]; - double *tmpx, *tmpy; - double *area_in, *area_out, min_area; - double lon_in_avg; - int n_in, n_out; - double xarea; - - - nx1 = *nlon_in; - ny1 = *nlat_in; - nx2 = *nlon_out; - ny2 = *nlat_out; - - nxgrid = 0; - nx1p = nx1 + 1; - nx2p = nx2 + 1; - - area_in = (double *)malloc(nx1*ny1*sizeof(double)); - area_out = (double *)malloc(nx2*ny2*sizeof(double)); - tmpx = (double *)malloc((nx2+1)*(ny2+1)*sizeof(double)); - tmpy = (double *)malloc((nx2+1)*(ny2+1)*sizeof(double)); - for(j2=0; j2<=ny2; j2++) for(i2=0; i2<=nx2; i2++) { - tmpx[j2*nx2p+i2] = lon_out[i2]; - tmpy[j2*nx2p+i2] = lat_out[j2]; - } - get_grid_area(nlon_in, nlat_in, lon_in, lat_in, area_in); - get_grid_area(nlon_out, nlat_out, tmpx, tmpy, area_out); - - free(tmpx); - free(tmpy); - - for(j2=0; j2 MASK_THRESH ) { - - y_in[0] = lat_in[j1*nx1p+i1]; - y_in[1] = lat_in[j1*nx1p+i1+1]; - y_in[2] = lat_in[(j1+1)*nx1p+i1+1]; - y_in[3] = lat_in[(j1+1)*nx1p+i1]; - if ( (y_in[0]<=ll_lat) && (y_in[1]<=ll_lat) - && (y_in[2]<=ll_lat) && (y_in[3]<=ll_lat) ) continue; - if ( (y_in[0]>=ur_lat) && (y_in[1]>=ur_lat) - && (y_in[2]>=ur_lat) && (y_in[3]>=ur_lat) ) continue; - - x_in[0] = lon_in[j1*nx1p+i1]; - x_in[1] = lon_in[j1*nx1p+i1+1]; - x_in[2] = lon_in[(j1+1)*nx1p+i1+1]; - x_in[3] = lon_in[(j1+1)*nx1p+i1]; - - n_in = fix_lon(x_in, y_in, 4, (ll_lon+ur_lon)/2); - lon_in_avg = avgval_double(n_in, x_in); - - if ( (n_out = clip ( x_in, y_in, n_in, ll_lon, ll_lat, ur_lon, ur_lat, x_out, y_out )) > 0 ) { - xarea = poly_area (x_out, y_out, n_out ) * mask_in[j1*nx1+i1]; - min_area = min(area_in[j1*nx1+i1], area_out[j2*nx2+i2]); - if(xarea/min_area > AREA_RATIO_THRESH ) { - xgrid_area[nxgrid] = xarea; - xgrid_clon[nxgrid] = poly_ctrlon(x_out, y_out, n_out, lon_in_avg); - xgrid_clat[nxgrid] = poly_ctrlat (x_out, y_out, n_out ); - i_in[nxgrid] = i1; - j_in[nxgrid] = j1; - i_out[nxgrid] = i2; - j_out[nxgrid] = j2; - ++nxgrid; - if(nxgrid > MAXXGRID) error_handler("nxgrid is greater than MAXXGRID, increase MAXXGRID"); - } - } - } - } - - free(area_in); - free(area_out); - - return nxgrid; - -} /* create_xgrid_2dx1d_order2 */ - -/******************************************************************************* - void create_xgrid_2DX2D_order1 - This routine generate exchange grids between two grids for the first order - conservative interpolation. nlon_in,nlat_in,nlon_out,nlat_out are the size of the grid cell - and lon_in,lat_in, lon_out,lat_out are geographic grid location of grid cell bounds. - mask is on grid lon_in/lat_in. -*******************************************************************************/ -int create_xgrid_2dx2d_order1_(const int *nlon_in, const int *nlat_in, const int *nlon_out, const int *nlat_out, - const double *lon_in, const double *lat_in, const double *lon_out, const double *lat_out, - const double *mask_in, int *i_in, int *j_in, int *i_out, - int *j_out, double *xgrid_area) -{ - int nxgrid; - - nxgrid = create_xgrid_2dx2d_order1(nlon_in, nlat_in, nlon_out, nlat_out, lon_in, lat_in, lon_out, lat_out, mask_in, - i_in, j_in, i_out, j_out, xgrid_area); - return nxgrid; - -} -int create_xgrid_2dx2d_order1(const int *nlon_in, const int *nlat_in, const int *nlon_out, const int *nlat_out, - const double *lon_in, const double *lat_in, const double *lon_out, const double *lat_out, - const double *mask_in, int *i_in, int *j_in, int *i_out, - int *j_out, double *xgrid_area) -{ - -#define MAX_V 8 - int nx1, nx2, ny1, ny2, nx1p, nx2p, nxgrid; - double *area_in, *area_out; - int nblocks =1; - int *istart2=NULL, *iend2=NULL; - int npts_left, nblks_left, pos, m, npts_my, ij; - double *lon_out_min_list,*lon_out_max_list,*lon_out_avg,*lat_out_min_list,*lat_out_max_list; - double *lon_out_list, *lat_out_list; - int *pnxgrid=NULL, *pstart; - int *pi_in=NULL, *pj_in=NULL, *pi_out=NULL, *pj_out=NULL; - double *pxgrid_area=NULL; - int *n2_list; - int nthreads, nxgrid_block_max; - - nx1 = *nlon_in; - ny1 = *nlat_in; - nx2 = *nlon_out; - ny2 = *nlat_out; - nx1p = nx1 + 1; - nx2p = nx2 + 1; - - area_in = (double *)malloc(nx1*ny1*sizeof(double)); - area_out = (double *)malloc(nx2*ny2*sizeof(double)); - get_grid_area(nlon_in, nlat_in, lon_in, lat_in, area_in); - get_grid_area(nlon_out, nlat_out, lon_out, lat_out, area_out); - - nthreads = 1; -#if defined(_OPENMP) -#pragma omp parallel - nthreads = omp_get_num_threads(); -#endif - - nblocks = nthreads; - - istart2 = (int *)malloc(nblocks*sizeof(int)); - iend2 = (int *)malloc(nblocks*sizeof(int)); - - pstart = (int *)malloc(nblocks*sizeof(int)); - pnxgrid = (int *)malloc(nblocks*sizeof(int)); - - nxgrid_block_max = MAXXGRID/nblocks; - - for(m=0; m MAX_V) error_handler("create_xgrid.c: n2_in is greater than MAX_V"); - lon_out_min_list[n] = minval_double(n2_in, x2_in); - lon_out_max_list[n] = maxval_double(n2_in, x2_in); - lon_out_avg[n] = avgval_double(n2_in, x2_in); - n2_list[n] = n2_in; - for(l=0; l MASK_THRESH ) { - int n0, n1, n2, n3, l,n1_in; - double lat_in_min,lat_in_max,lon_in_min,lon_in_max,lon_in_avg; - double x1_in[MV], y1_in[MV], x_out[MV], y_out[MV]; - - n0 = j1*nx1p+i1; n1 = j1*nx1p+i1+1; - n2 = (j1+1)*nx1p+i1+1; n3 = (j1+1)*nx1p+i1; - x1_in[0] = lon_in[n0]; y1_in[0] = lat_in[n0]; - x1_in[1] = lon_in[n1]; y1_in[1] = lat_in[n1]; - x1_in[2] = lon_in[n2]; y1_in[2] = lat_in[n2]; - x1_in[3] = lon_in[n3]; y1_in[3] = lat_in[n3]; - lat_in_min = minval_double(4, y1_in); - lat_in_max = maxval_double(4, y1_in); - n1_in = fix_lon(x1_in, y1_in, 4, M_PI); - lon_in_min = minval_double(n1_in, x1_in); - lon_in_max = maxval_double(n1_in, x1_in); - lon_in_avg = avgval_double(n1_in, x1_in); - for(ij=istart2[m]; ij<=iend2[m]; ij++) { - int n_out, i2, j2, n2_in; - double xarea, dx, lon_out_min, lon_out_max; - double x2_in[MAX_V], y2_in[MAX_V]; - - i2 = ij%nx2; - j2 = ij/nx2; - - if(lat_out_min_list[ij] >= lat_in_max || lat_out_max_list[ij] <= lat_in_min ) continue; - /* adjust x2_in according to lon_in_avg*/ - n2_in = n2_list[ij]; - for(l=0; l M_PI) { - lon_out_min -= TPI; - lon_out_max -= TPI; - for (l=0; l= lon_in_max || lon_out_max <= lon_in_min ) continue; - if ( (n_out = clip_2dx2d( x1_in, y1_in, n1_in, x2_in, y2_in, n2_in, x_out, y_out )) > 0) { - double min_area; - int nn; - xarea = poly_area (x_out, y_out, n_out ) * mask_in[j1*nx1+i1]; - min_area = min(area_in[j1*nx1+i1], area_out[j2*nx2+i2]); - if( xarea/min_area > AREA_RATIO_THRESH ) { - pnxgrid[m]++; - if(pnxgrid[m]>= MAXXGRID/nthreads) - error_handler("nxgrid is greater than MAXXGRID/nthreads, increase MAXXGRID, decrease nthreads, or increase number of MPI ranks"); - nn = pstart[m] + pnxgrid[m]-1; - - pxgrid_area[nn] = xarea; - pi_in[nn] = i1; - pj_in[nn] = j1; - pi_out[nn] = i2; - pj_out[nn] = j2; - } - - } - - } - } - } - - /*copy data if nblocks > 1 */ - if(nblocks == 1) { - nxgrid = pnxgrid[0]; - pi_in = NULL; - pj_in = NULL; - pi_out = NULL; - pj_out = NULL; - pxgrid_area = NULL; - } - else { - int nn, i; - nxgrid = 0; - for(m=0; m MAX_V) error_handler("create_xgrid.c: n2_in is greater than MAX_V"); - lon_out_min_list[n] = minval_double(n2_in, x2_in); - lon_out_max_list[n] = maxval_double(n2_in, x2_in); - lon_out_avg[n] = avgval_double(n2_in, x2_in); - n2_list[n] = n2_in; - for(l=0; l MASK_THRESH ) { - int n0, n1, n2, n3, l,n1_in; - double lat_in_min,lat_in_max,lon_in_min,lon_in_max,lon_in_avg; - double x1_in[MV], y1_in[MV], x_out[MV], y_out[MV]; - - n0 = j1*nx1p+i1; n1 = j1*nx1p+i1+1; - n2 = (j1+1)*nx1p+i1+1; n3 = (j1+1)*nx1p+i1; - x1_in[0] = lon_in[n0]; y1_in[0] = lat_in[n0]; - x1_in[1] = lon_in[n1]; y1_in[1] = lat_in[n1]; - x1_in[2] = lon_in[n2]; y1_in[2] = lat_in[n2]; - x1_in[3] = lon_in[n3]; y1_in[3] = lat_in[n3]; - lat_in_min = minval_double(4, y1_in); - lat_in_max = maxval_double(4, y1_in); - n1_in = fix_lon(x1_in, y1_in, 4, M_PI); - lon_in_min = minval_double(n1_in, x1_in); - lon_in_max = maxval_double(n1_in, x1_in); - lon_in_avg = avgval_double(n1_in, x1_in); - for(ij=istart2[m]; ij<=iend2[m]; ij++) { - int n_out, i2, j2, n2_in; - double xarea, dx, lon_out_min, lon_out_max; - double x2_in[MAX_V], y2_in[MAX_V]; - - i2 = ij%nx2; - j2 = ij/nx2; - - if(lat_out_min_list[ij] >= lat_in_max || lat_out_max_list[ij] <= lat_in_min ) continue; - /* adjust x2_in according to lon_in_avg*/ - n2_in = n2_list[ij]; - for(l=0; l M_PI) { - lon_out_min -= TPI; - lon_out_max -= TPI; - for (l=0; l= lon_in_max || lon_out_max <= lon_in_min ) continue; - if ( (n_out = clip_2dx2d( x1_in, y1_in, n1_in, x2_in, y2_in, n2_in, x_out, y_out )) > 0) { - double min_area; - int nn; - xarea = poly_area (x_out, y_out, n_out ) * mask_in[j1*nx1+i1]; - min_area = min(area_in[j1*nx1+i1], area_out[j2*nx2+i2]); - if( xarea/min_area > AREA_RATIO_THRESH ) { - pnxgrid[m]++; - if(pnxgrid[m]>= MAXXGRID/nthreads) - error_handler("nxgrid is greater than MAXXGRID/nthreads, increase MAXXGRID, decrease nthreads, or increase number of MPI ranks"); - nn = pstart[m] + pnxgrid[m]-1; - pxgrid_area[nn] = xarea; - pxgrid_clon[nn] = poly_ctrlon(x_out, y_out, n_out, lon_in_avg); - pxgrid_clat[nn] = poly_ctrlat (x_out, y_out, n_out ); - pi_in[nn] = i1; - pj_in[nn] = j1; - pi_out[nn] = i2; - pj_out[nn] = j2; - } - } - } - } - } - - /*copy data if nblocks > 1 */ - if(nblocks == 1) { - nxgrid = pnxgrid[0]; - pi_in = NULL; - pj_in = NULL; - pi_out = NULL; - pj_out = NULL; - pxgrid_area = NULL; - pxgrid_clon = NULL; - pxgrid_clat = NULL; - } - else { - int nn, i; - nxgrid = 0; - for(m=0; m= ll_lon); - for (i_in=0,i_out=0;i_in= ll_lon))!=inside_last) { - x_tmp[i_out] = ll_lon; - y_tmp[i_out++] = y_last + (ll_lon - x_last) * (lat_in[i_in] - y_last) / (lon_in[i_in] - x_last); - } - - /* if "to" point is right of LEFT boundary, output it */ - if (inside) { - x_tmp[i_out] = lon_in[i_in]; - y_tmp[i_out++] = lat_in[i_in]; - } - x_last = lon_in[i_in]; - y_last = lat_in[i_in]; - inside_last = inside; - } - if (!(n_out=i_out)) return(0); - - /* clip polygon with RIGHT boundary - clip V_TMP to V_OUT */ - x_last = x_tmp[n_out-1]; - y_last = y_tmp[n_out-1]; - inside_last = (x_last <= ur_lon); - for (i_in=0,i_out=0;i_in= ll_lat); - for (i_in=0,i_out=0;i_in= ll_lat))!=inside_last) { - y_tmp[i_out] = ll_lat; - x_tmp[i_out++] = x_last + (ll_lat - y_last) * (lon_out[i_in] - x_last) / (lat_out[i_in] - y_last); - } - - /* if "to" point is above BOTTOM boundary, output it */ - if (inside) { - x_tmp[i_out] = lon_out[i_in]; - y_tmp[i_out++] = lat_out[i_in]; - } - x_last = lon_out[i_in]; - y_last = lat_out[i_in]; - inside_last = inside; - } - if (!(n_out=i_out)) return(0); - - /* clip polygon with TOP boundary - clip V_TMP to V_OUT */ - x_last = x_tmp[n_out-1]; - y_last = y_tmp[n_out-1]; - inside_last = (y_last <= ur_lat); - for (i_in=0,i_out=0;i_in and - should not parallel to the line between and - may need to consider truncation error */ - dy1 = y1_1-y1_0; - dy2 = y2_1-y2_0; - dx1 = x1_1-x1_0; - dx2 = x2_1-x2_0; - ds1 = y1_0*x1_1 - y1_1*x1_0; - ds2 = y2_0*x2_1 - y2_1*x2_0; - determ = dy2*dx1 - dy1*dx2; - if(fabs(determ) < EPSLN30) { - error_handler("the line between and should not parallel to " - "the line between and "); - } - lon_out[i_out] = (dx2*ds1 - dx1*ds2)/determ; - lat_out[i_out++] = (dy2*ds1 - dy1*ds2)/determ; - - - } - if(inside) { - lon_out[i_out] = x1_1; - lat_out[i_out++] = y1_1; - } - x1_0 = x1_1; - y1_0 = y1_1; - inside_last = inside; - } - if(!(n_out=i_out)) return 0; - for(i1=0; i1 MASK_THRESH ) { - /* clockwise */ - n0 = j1*nx1p+i1; n1 = (j1+1)*nx1p+i1; - n2 = (j1+1)*nx1p+i1+1; n3 = j1*nx1p+i1+1; - x1_in[0] = x1[n0]; y1_in[0] = y1[n0]; z1_in[0] = z1[n0]; - x1_in[1] = x1[n1]; y1_in[1] = y1[n1]; z1_in[1] = z1[n1]; - x1_in[2] = x1[n2]; y1_in[2] = y1[n2]; z1_in[2] = z1[n2]; - x1_in[3] = x1[n3]; y1_in[3] = y1[n3]; z1_in[3] = z1[n3]; - - for(j2=0; j2 0) { - xarea = great_circle_area ( n_out, x_out, y_out, z_out ) * mask_in[j1*nx1+i1]; - min_area = min(area1[j1*nx1+i1], area2[j2*nx2+i2]); - if( xarea/min_area > AREA_RATIO_THRESH ) { -#ifdef debug_test_create_xgrid - printf("(i2,j2)=(%d,%d), (i1,j1)=(%d,%d), xarea=%g\n", i2, j2, i1, j1, xarea); -#endif - xgrid_area[nxgrid] = xarea; - xgrid_clon[nxgrid] = 0; /*z1l: will be developed very soon */ - xgrid_clat[nxgrid] = 0; - i_in[nxgrid] = i1; - j_in[nxgrid] = j1; - i_out[nxgrid] = i2; - j_out[nxgrid] = j2; - ++nxgrid; - if(nxgrid > MAXXGRID) error_handler("nxgrid is greater than MAXXGRID, increase MAXXGRID"); - } - } - } - } - - - free(area1); - free(area2); - - free(x1); - free(y1); - free(z1); - free(x2); - free(y2); - free(z2); - - return nxgrid; - -}/* create_xgrid_great_circle */ - -int create_xgrid_great_circle_ug_(const int *nlon_in, const int *nlat_in, const int *npts_out, - const double *lon_in, const double *lat_in, const double *lon_out, const double *lat_out, - const double *mask_in, int *i_in, int *j_in, int *l_out, - double *xgrid_area, double *xgrid_clon, double *xgrid_clat) -{ - int nxgrid; - nxgrid = create_xgrid_great_circle_ug(nlon_in, nlat_in, npts_out, lon_in, lat_in, lon_out, lat_out, - mask_in, i_in, j_in, l_out, xgrid_area, xgrid_clon, xgrid_clat); - - return nxgrid; -} - -int create_xgrid_great_circle_ug(const int *nlon_in, const int *nlat_in, const int *npts_out, - const double *lon_in, const double *lat_in, const double *lon_out, const double *lat_out, - const double *mask_in, int *i_in, int *j_in, int *l_out, - double *xgrid_area, double *xgrid_clon, double *xgrid_clat) -{ - - int nx1, ny1, npts2, nx1p, ny1p, nxgrid, n1_in, n2_in, nv; - int n0, n1, n2, n3, i1, j1, l2; - double x1_in[MV], y1_in[MV], z1_in[MV]; - double x2_in[MV], y2_in[MV], z2_in[MV]; - double x_out[MV], y_out[MV], z_out[MV]; - double *x1=NULL, *y1=NULL, *z1=NULL; - double *x2=NULL, *y2=NULL, *z2=NULL; - - double *area1, *area2, min_area; - - nx1 = *nlon_in; - ny1 = *nlat_in; - nv = 4; - npts2 = *npts_out; - nxgrid = 0; - nx1p = nx1 + 1; - ny1p = ny1 + 1; - - /* first convert lon-lat to cartesian coordinates */ - x1 = (double *)malloc(nx1p*ny1p*sizeof(double)); - y1 = (double *)malloc(nx1p*ny1p*sizeof(double)); - z1 = (double *)malloc(nx1p*ny1p*sizeof(double)); - x2 = (double *)malloc(npts2*nv*sizeof(double)); - y2 = (double *)malloc(npts2*nv*sizeof(double)); - z2 = (double *)malloc(npts2*nv*sizeof(double)); - - latlon2xyz(nx1p*ny1p, lon_in, lat_in, x1, y1, z1); - latlon2xyz(npts2*nv, lon_out, lat_out, x2, y2, z2); - - area1 = (double *)malloc(nx1*ny1*sizeof(double)); - area2 = (double *)malloc(npts2*sizeof(double)); - get_grid_great_circle_area(nlon_in, nlat_in, lon_in, lat_in, area1); - get_grid_great_circle_area_ug(npts_out, lon_out, lat_out, area2); - n1_in = 4; - n2_in = 4; - - for(j1=0; j1 MASK_THRESH ) { - /* clockwise */ - n0 = j1*nx1p+i1; n1 = (j1+1)*nx1p+i1; - n2 = (j1+1)*nx1p+i1+1; n3 = j1*nx1p+i1+1; - x1_in[0] = x1[n0]; y1_in[0] = y1[n0]; z1_in[0] = z1[n0]; - x1_in[1] = x1[n1]; y1_in[1] = y1[n1]; z1_in[1] = z1[n1]; - x1_in[2] = x1[n2]; y1_in[2] = y1[n2]; z1_in[2] = z1[n2]; - x1_in[3] = x1[n3]; y1_in[3] = y1[n3]; z1_in[3] = z1[n3]; - - for(l2=0; l2 0) { - xarea = great_circle_area ( n_out, x_out, y_out, z_out ) * mask_in[j1*nx1+i1]; - min_area = min(area1[j1*nx1+i1], area2[l2]); - if( xarea/min_area > AREA_RATIO_THRESH ) { -#ifdef debug_test_create_xgrid - printf("(l2)=(%d,%d), (i1,j1)=(%d,%d), xarea=%g\n", l2, i1, j1, xarea); -#endif - xgrid_area[nxgrid] = xarea; - xgrid_clon[nxgrid] = 0; /*z1l: will be developed very soon */ - xgrid_clat[nxgrid] = 0; - i_in[nxgrid] = i1; - j_in[nxgrid] = j1; - l_out[nxgrid] = l2; - ++nxgrid; - if(nxgrid > MAXXGRID) error_handler("nxgrid is greater than MAXXGRID, increase MAXXGRID"); - } - } - } - } - - - free(area1); - free(area2); - - free(x1); - free(y1); - free(z1); - free(x2); - free(y2); - free(z2); - - return nxgrid; - -}/* create_xgrid_great_circle_ug */ - - -/******************************************************************************* - Revise Sutherland-Hodgeman algorithm to find the vertices of the overlapping - between any two grid boxes. It return the number of vertices for the exchange grid. - Each edge of grid box is a part of great circle. All the points are cartesian - coordinates. Here we are assuming each polygon is convex. - RANGE_CHECK_CRITERIA is used to determine if the two grid boxes are possible to be - overlap. The size should be between 0 and 0.5. The larger the range_check_criteria, - the more expensive of the computatioin. When the value is close to 0, - some small exchange grid might be lost. Suggest to use value 0.05 for C48. -*******************************************************************************/ - -int clip_2dx2d_great_circle(const double x1_in[], const double y1_in[], const double z1_in[], int n1_in, - const double x2_in[], const double y2_in[], const double z2_in [], int n2_in, - double x_out[], double y_out[], double z_out[]) -{ - struct Node *grid1List=NULL; - struct Node *grid2List=NULL; - struct Node *intersectList=NULL; - struct Node *polyList=NULL; - struct Node *curList=NULL; - struct Node *firstIntersect=NULL, *curIntersect=NULL; - struct Node *temp1=NULL, *temp2=NULL, *temp=NULL; - - int i1, i2, i1p, i2p, i2p2, npts1, npts2; - int nintersect, n_out; - int maxiter1, maxiter2, iter1, iter2; - int found1, found2, curListNum; - int has_inbound, inbound; - double pt1[MV][3], pt2[MV][3]; - double *p1_0=NULL, *p1_1=NULL; - double *p2_0=NULL, *p2_1=NULL, *p2_2=NULL; - double intersect[3]; - double u1, u2; - double min_x1, max_x1, min_y1, max_y1, min_z1, max_z1; - double min_x2, max_x2, min_y2, max_y2, min_z2, max_z2; - - - /* first check the min and max of (x1_in, y1_in, z1_in) with (x2_in, y2_in, z2_in) */ - min_x1 = minval_double(n1_in, x1_in); - max_x2 = maxval_double(n2_in, x2_in); - if(min_x1 >= max_x2+RANGE_CHECK_CRITERIA) return 0; - max_x1 = maxval_double(n1_in, x1_in); - min_x2 = minval_double(n2_in, x2_in); - if(min_x2 >= max_x1+RANGE_CHECK_CRITERIA) return 0; - - min_y1 = minval_double(n1_in, y1_in); - max_y2 = maxval_double(n2_in, y2_in); - if(min_y1 >= max_y2+RANGE_CHECK_CRITERIA) return 0; - max_y1 = maxval_double(n1_in, y1_in); - min_y2 = minval_double(n2_in, y2_in); - if(min_y2 >= max_y1+RANGE_CHECK_CRITERIA) return 0; - - min_z1 = minval_double(n1_in, z1_in); - max_z2 = maxval_double(n2_in, z2_in); - if(min_z1 >= max_z2+RANGE_CHECK_CRITERIA) return 0; - max_z1 = maxval_double(n1_in, z1_in); - min_z2 = minval_double(n2_in, z2_in); - if(min_z2 >= max_z1+RANGE_CHECK_CRITERIA) return 0; - - rewindList(); - - grid1List = getNext(); - grid2List = getNext(); - intersectList = getNext(); - polyList = getNext(); - - /* insert points into SubjList and ClipList */ - for(i1=0; i1isInside = 1; - else - temp->isInside = 0; - temp = getNextNode(temp); - } - -#ifdef debug_test_create_xgrid - printf("\nNOTE from clip_2dx2d_great_circle: begin to set inside value of grid2List\n"); -#endif - /* check if grid2List is inside grid1List */ - temp = grid2List; - - while(temp) { - if(insidePolygon(temp, grid1List)) - temp->isInside = 1; - else - temp->isInside = 0; - temp = getNextNode(temp); - } - - /* make sure the grid box is clockwise */ - - /*make sure each polygon is convex, which is equivalent that the great_circle_area is positive */ - if( gridArea(grid1List) <= 0 ) - error_handler("create_xgrid.c(clip_2dx2d_great_circle): grid box 1 is not convex"); - if( gridArea(grid2List) <= 0 ) - error_handler("create_xgrid.c(clip_2dx2d_great_circle): grid box 2 is not convex"); - -#ifdef debug_test_create_xgrid - printNode(grid1List, "grid1List"); - printNode(grid2List, "grid2List"); -#endif - - /* get the coordinates from grid1List and grid2List. - Please not npts1 might not equal n1_in, npts2 might not equal n2_in because of pole - */ - - temp = grid1List; - for(i1=0; i1Next; - } - temp = grid2List; - for(i2=0; i2Next; - } - - firstIntersect=getNext(); - curIntersect = getNext(); - -#ifdef debug_test_create_xgrid - printf("\n\n************************ Start line_intersect_2D_3D ******************************\n"); -#endif - /* first find all the intersection points */ - nintersect = 0; - for(i1=0; i1 1) { - getFirstInbound(intersectList, firstIntersect); - if(firstIntersect->initialized) { - has_inbound = 1; - } - } - - /* when has_inbound == 0, get the grid1List and grid2List */ - if( !has_inbound && nintersect > 1) { - setInbound(intersectList, grid1List); - getFirstInbound(intersectList, firstIntersect); - if(firstIntersect->initialized) has_inbound = 1; - } - - /* if has_inbound = 1, find the overlapping */ - n_out = 0; - - if(has_inbound) { - maxiter1 = nintersect; -#ifdef debug_test_create_xgrid - printf("\nNOTE from clip_2dx2d_great_circle: number of intersect is %d\n", nintersect); - printf("\n size of grid2List is %d, size of grid1List is %d\n", length(grid2List), length(grid1List)); - printNode(intersectList, "beginning intersection list"); - printNode(grid2List, "beginning clip list"); - printNode(grid1List, "beginning subj list"); - printf("\n************************ End line_intersect_2D_3D **********************************\n\n"); -#endif - temp1 = getNode(grid1List, *firstIntersect); - if( temp1 == NULL) { - double lon[10], lat[10]; - int i; - xyz2latlon(n1_in, x1_in, y1_in, z1_in, lon, lat); - for(i=0; i< n1_in; i++) printf("lon1 = %g, lat1 = %g\n", lon[i]*R2D, lat[i]*R2D); - printf("\n"); - xyz2latlon(n2_in, x2_in, y2_in, z2_in, lon, lat); - for(i=0; i< n2_in; i++) printf("lon2 = %g, lat2 = %g\n", lon[i]*R2D, lat[i]*R2D); - printf("\n"); - - error_handler("firstIntersect is not in the grid1List"); - } - addNode(polyList, *firstIntersect); - nintersect--; -#ifdef debug_test_create_xgrid - printNode(polyList, "polyList at stage 1"); -#endif - - /* Loop over the grid1List and grid2List to find again the firstIntersect */ - curList = grid1List; - curListNum = 0; - - /* Loop through curList to find the next intersection, the loop will end - when come back to firstIntersect - */ - copyNode(curIntersect, *firstIntersect); - iter1 = 0; - found1 = 0; - - while( iter1 < maxiter1 ) { -#ifdef debug_test_create_xgrid - printf("\n----------- At iteration = %d\n\n", iter1+1 ); - printNode(curIntersect, "curIntersect at the begining of iter1"); -#endif - /* find the curIntersect in curList and get the next intersection points */ - temp1 = getNode(curList, *curIntersect); - temp2 = temp1->Next; - if( temp2 == NULL ) temp2 = curList; - - maxiter2 = length(curList); - found2 = 0; - iter2 = 0; - /* Loop until find the next intersection */ - while( iter2 < maxiter2 ) { - int temp2IsIntersect; - - temp2IsIntersect = 0; - if( isIntersect( *temp2 ) ) { /* copy the point and switch to the grid2List */ - struct Node *temp3; - - /* first check if temp2 is the firstIntersect */ - if( sameNode( *temp2, *firstIntersect) ) { - found1 = 1; - break; - } - - temp3 = temp2->Next; - if( temp3 == NULL) temp3 = curList; - if( temp3 == NULL) error_handler("creat_xgrid.c: temp3 can not be NULL"); - found2 = 1; - /* if next node is inside or an intersection, - need to keep on curList - */ - temp2IsIntersect = 1; - if( isIntersect(*temp3) || (temp3->isInside == 1) ) found2 = 0; - } - if(found2) { - copyNode(curIntersect, *temp2); - break; - } - else { - addNode(polyList, *temp2); -#ifdef debug_test_create_xgrid - printNode(polyList, "polyList at stage 2"); -#endif - if(temp2IsIntersect) { - nintersect--; - } - } - temp2 = temp2->Next; - if( temp2 == NULL ) temp2 = curList; - iter2 ++; - } - if(found1) break; - - if( !found2 ) error_handler(" not found the next intersection "); - - /* if find the first intersection, the poly found */ - if( sameNode( *curIntersect, *firstIntersect) ) { - found1 = 1; - break; - } - - /* add curIntersect to polyList and remove it from intersectList and curList */ - addNode(polyList, *curIntersect); -#ifdef debug_test_create_xgrid - printNode(polyList, "polyList at stage 3"); -#endif - nintersect--; - - - /* switch curList */ - if( curListNum == 0) { - curList = grid2List; - curListNum = 1; - } - else { - curList = grid1List; - curListNum = 0; - } - iter1++; - } - if(!found1) error_handler("not return back to the first intersection"); - - /* currently we are only clipping convex polygon to convex polygon */ - if( nintersect > 0) error_handler("After clipping, nintersect should be 0"); - - /* copy the polygon to x_out, y_out, z_out */ - temp1 = polyList; - while (temp1 != NULL) { - getCoordinate(*temp1, x_out+n_out, y_out+n_out, z_out+n_out); - temp1 = temp1->Next; - n_out++; - } - - /* if(n_out < 3) error_handler(" The clipped region has < 3 vertices"); */ - if( n_out < 3) n_out = 0; -#ifdef debug_test_create_xgrid - printNode(polyList, "polyList after clipping"); -#endif - } - - /* check if grid1 is inside grid2 */ - if(n_out==0){ - /* first check number of points in grid1 is inside grid2 */ - int n, n1in2; - /* One possible is that grid1List is inside grid2List */ -#ifdef debug_test_create_xgrid - printf("\nNOTE from clip_2dx2d_great_circle: check if grid1 is inside grid2\n"); -#endif - n1in2 = 0; - temp = grid1List; - while(temp) { - if(temp->intersect != 1) { -#ifdef debug_test_create_xgrid - printf("grid1->isInside = %d\n", temp->isInside); -#endif - if( temp->isInside == 1) n1in2++; - } - temp = getNextNode(temp); - } - if(npts1==n1in2) { /* grid1 is inside grid2 */ - n_out = npts1; - n = 0; - temp = grid1List; - while( temp ) { - getCoordinate(*temp, &x_out[n], &y_out[n], &z_out[n]); - n++; - temp = getNextNode(temp); - } - } - if(n_out>0) return n_out; - } - - /* check if grid2List is inside grid1List */ - if(n_out ==0){ - int n, n2in1; -#ifdef debug_test_create_xgrid - printf("\nNOTE from clip_2dx2d_great_circle: check if grid2 is inside grid1\n"); -#endif - - temp = grid2List; - n2in1 = 0; - while(temp) { - if(temp->intersect != 1) { -#ifdef debug_test_create_xgrid - printf("grid2->isInside = %d\n", temp->isInside); -#endif - if( temp->isInside == 1) n2in1++; - } - temp = getNextNode(temp); - } - - if(npts2==n2in1) { /* grid2 is inside grid1 */ - n_out = npts2; - n = 0; - temp = grid2List; - while( temp ) { - getCoordinate(*temp, &x_out[n], &y_out[n], &z_out[n]); - n++; - temp = getNextNode(temp); - } - - } - } - - - return n_out; -} - - -/* Intersects between the line a and the seqment s - where both line and segment are great circle lines on the sphere represented by - 3D cartesian points. - [sin sout] are the ends of a line segment - returns true if the lines could be intersected, false otherwise. - inbound means the direction of (a1,a2) go inside or outside of (q1,q2,q3) -*/ - -int line_intersect_2D_3D(double *a1, double *a2, double *q1, double *q2, double *q3, - double *intersect, double *u_a, double *u_q, int *inbound){ - - /* Do this intersection by reprsenting the line a1 to a2 as a plane through the - two line points and the origin of the sphere (0,0,0). This is the - definition of a great circle arc. - */ - double plane[9]; - double plane_p[2]; - double u; - double p1[3], v1[3], v2[3]; - double c1[3], c2[3], c3[3]; - double coincident, sense, norm; - int i; - int is_inter1, is_inter2; - - *inbound = 0; - - /* first check if any vertices are the same */ - if(samePoint(a1[0], a1[1], a1[2], q1[0], q1[1], q1[2])) { - *u_a = 0; - *u_q = 0; - intersect[0] = a1[0]; - intersect[1] = a1[1]; - intersect[2] = a1[2]; -#ifdef debug_test_create_xgrid - printf("\nNOTE from line_intersect_2D_3D: u_a = %19.15f, u_q=%19.15f, inbound=%d\n", *u_a, *u_q, *inbound); -#endif - return 1; - } - else if (samePoint(a1[0], a1[1], a1[2], q2[0], q2[1], q2[2])) { - *u_a = 0; - *u_q = 1; - intersect[0] = a1[0]; - intersect[1] = a1[1]; - intersect[2] = a1[2]; -#ifdef debug_test_create_xgrid - printf("\nNOTE from line_intersect_2D_3D: u_a = %19.15f, u_q=%19.15f, inbound=%d\n", *u_a, *u_q, *inbound); -#endif - return 1; - } - else if(samePoint(a2[0], a2[1], a2[2], q1[0], q1[1], q1[2])) { -#ifdef debug_test_create_xgrid - printf("\nNOTE from line_intersect_2D_3D: u_a = %19.15f, u_q=%19.15f, inbound=%d\n", *u_a, *u_q, *inbound); -#endif - *u_a = 1; - *u_q = 0; - intersect[0] = a2[0]; - intersect[1] = a2[1]; - intersect[2] = a2[2]; - return 1; - } - else if (samePoint(a2[0], a2[1], a2[2], q2[0], q2[1], q2[2])) { -#ifdef debug_test_create_xgrid - printf("\nNOTE from line_intersect_2D_3D: u_a = %19.15f, u_q=%19.15f, inbound=%d\n", *u_a, *u_q, *inbound); -#endif - *u_a = 1; - *u_q = 1; - intersect[0] = a2[0]; - intersect[1] = a2[1]; - intersect[2] = a2[2]; - return 1; - } - - - /* Load points defining plane into variable (these are supposed to be in counterclockwise order) */ - plane[0]=q1[0]; - plane[1]=q1[1]; - plane[2]=q1[2]; - plane[3]=q2[0]; - plane[4]=q2[1]; - plane[5]=q2[2]; - plane[6]=0.0; - plane[7]=0.0; - plane[8]=0.0; - - /* Intersect the segment with the plane */ - is_inter1 = intersect_tri_with_line(plane, a1, a2, plane_p, u_a); - - if(!is_inter1) - return 0; - - if(fabs(*u_a) < EPSLN8) *u_a = 0; - if(fabs(*u_a-1) < EPSLN8) *u_a = 1; - - -#ifdef debug_test_create_xgrid - printf("\nNOTE from line_intersect_2D_3D: u_a = %19.15f\n", *u_a); -#endif - - - if( (*u_a < 0) || (*u_a > 1) ) return 0; - - /* Load points defining plane into variable (these are supposed to be in counterclockwise order) */ - plane[0]=a1[0]; - plane[1]=a1[1]; - plane[2]=a1[2]; - plane[3]=a2[0]; - plane[4]=a2[1]; - plane[5]=a2[2]; - plane[6]=0.0; - plane[7]=0.0; - plane[8]=0.0; - - /* Intersect the segment with the plane */ - is_inter2 = intersect_tri_with_line(plane, q1, q2, plane_p, u_q); - - if(!is_inter2) - return 0; - - if(fabs(*u_q) < EPSLN8) *u_q = 0; - if(fabs(*u_q-1) < EPSLN8) *u_q = 1; -#ifdef debug_test_create_xgrid - printf("\nNOTE from line_intersect_2D_3D: u_q = %19.15f\n", *u_q); -#endif - - - if( (*u_q < 0) || (*u_q > 1) ) return 0; - - u =*u_a; - - /* The two planes are coincidental */ - vect_cross(a1, a2, c1); - vect_cross(q1, q2, c2); - vect_cross(c1, c2, c3); - coincident = metric(c3); - - if(fabs(coincident) < EPSLN30) return 0; - - /* Calculate point of intersection */ - intersect[0]=a1[0] + u*(a2[0]-a1[0]); - intersect[1]=a1[1] + u*(a2[1]-a1[1]); - intersect[2]=a1[2] + u*(a2[2]-a1[2]); - - norm = metric( intersect ); - for(i = 0; i < 3; i ++) intersect[i] /= norm; - - /* when u_q =0 or u_q =1, the following could not decide the inbound value */ - if(*u_q != 0 && *u_q != 1){ - - p1[0] = a2[0]-a1[0]; - p1[1] = a2[1]-a1[1]; - p1[2] = a2[2]-a1[2]; - v1[0] = q2[0]-q1[0]; - v1[1] = q2[1]-q1[1]; - v1[2] = q2[2]-q1[2]; - v2[0] = q3[0]-q2[0]; - v2[1] = q3[1]-q2[1]; - v2[2] = q3[2]-q2[2]; - - vect_cross(v1, v2, c1); - vect_cross(v1, p1, c2); - - sense = dot(c1, c2); - *inbound = 1; - if(sense > 0) *inbound = 2; /* v1 going into v2 in CCW sense */ - } -#ifdef debug_test_create_xgrid - printf("\nNOTE from line_intersect_2D_3D: inbound=%d\n", *inbound); -#endif - - return 1; -} - - -/*------------------------------------------------------------------------------ - double poly_ctrlat(const double x[], const double y[], int n) - This routine is used to calculate the latitude of the centroid - ---------------------------------------------------------------------------*/ - -double poly_ctrlat(const double x[], const double y[], int n) -{ - double ctrlat = 0.0; - int i; - - for (i=0;i M_PI) dx = dx - 2.0*M_PI; - if(dx < -M_PI) dx = dx + 2.0*M_PI; - - if ( fabs(hdy)< SMALL_VALUE ) /* cheap area calculation along latitude */ - ctrlat -= dx*(2*cos(avg_y) + lat2*sin(avg_y) - cos(lat1) ); - else - ctrlat -= dx*( (sin(hdy)/hdy)*(2*cos(avg_y) + lat2*sin(avg_y)) - cos(lat1) ); - } - return (ctrlat*RADIUS*RADIUS); -} /* poly_ctrlat */ - -/*------------------------------------------------------------------------------ - double poly_ctrlon(const double x[], const double y[], int n, double clon) - This routine is used to calculate the lontitude of the centroid. - ---------------------------------------------------------------------------*/ -double poly_ctrlon(const double x[], const double y[], int n, double clon) -{ - double ctrlon = 0.0; - int i; - - for (i=0;i M_PI) dphi = dphi - 2.0*M_PI; - if(dphi < -M_PI) dphi = dphi + 2.0*M_PI; - dphi1 = phi1 - clon; - if( dphi1 > M_PI) dphi1 -= 2.0*M_PI; - if( dphi1 <-M_PI) dphi1 += 2.0*M_PI; - dphi2 = phi2 -clon; - if( dphi2 > M_PI) dphi2 -= 2.0*M_PI; - if( dphi2 <-M_PI) dphi2 += 2.0*M_PI; - - if(fabs(dphi2 -dphi1) < M_PI) { - ctrlon -= dphi * (dphi1*f1+dphi2*f2)/2.0; - } - else { - if(dphi1 > 0.0) - fac = M_PI; - else - fac = -M_PI; - fint = f1 + (f2-f1)*(fac-dphi1)/fabs(dphi); - ctrlon -= 0.5*dphi1*(dphi1-fac)*f1 - 0.5*dphi2*(dphi2+fac)*f2 - + 0.5*fac*(dphi1+dphi2)*fint; - } - - } - return (ctrlon*RADIUS*RADIUS); -} /* poly_ctrlon */ - -/* ----------------------------------------------------------------------------- - double box_ctrlat(double ll_lon, double ll_lat, double ur_lon, double ur_lat) - This routine is used to calculate the latitude of the centroid. - ---------------------------------------------------------------------------*/ -double box_ctrlat(double ll_lon, double ll_lat, double ur_lon, double ur_lat) -{ - double dphi = ur_lon-ll_lon; - double ctrlat; - - if(dphi > M_PI) dphi = dphi - 2.0*M_PI; - if(dphi < -M_PI) dphi = dphi + 2.0*M_PI; - ctrlat = dphi*(cos(ur_lat) + ur_lat*sin(ur_lat)-(cos(ll_lat) + ll_lat*sin(ll_lat))); - return (ctrlat*RADIUS*RADIUS); -} /* box_ctrlat */ - -/*------------------------------------------------------------------------------ - double box_ctrlon(double ll_lon, double ll_lat, double ur_lon, double ur_lat, double clon) - This routine is used to calculate the lontitude of the centroid - ----------------------------------------------------------------------------*/ -double box_ctrlon(double ll_lon, double ll_lat, double ur_lon, double ur_lat, double clon) -{ - double phi1, phi2, dphi, lat1, lat2, dphi1, dphi2; - double f1, f2, fac, fint; - double ctrlon = 0.0; - int i; - for( i =0; i<2; i++) { - if(i == 0) { - phi1 = ur_lon; - phi2 = ll_lon; - lat1 = lat2 = ll_lat; - } - else { - phi1 = ll_lon; - phi2 = ur_lon; - lat1 = lat2 = ur_lat; - } - dphi = phi1 - phi2; - f1 = 0.5*(cos(lat1)*sin(lat1)+lat1); - f2 = 0.5*(cos(lat2)*sin(lat2)+lat2); - - if(dphi > M_PI) dphi = dphi - 2.0*M_PI; - if(dphi < -M_PI) dphi = dphi + 2.0*M_PI; - /* make sure the center is in the same grid box. */ - dphi1 = phi1 - clon; - if( dphi1 > M_PI) dphi1 -= 2.0*M_PI; - if( dphi1 <-M_PI) dphi1 += 2.0*M_PI; - dphi2 = phi2 -clon; - if( dphi2 > M_PI) dphi2 -= 2.0*M_PI; - if( dphi2 <-M_PI) dphi2 += 2.0*M_PI; - - if(fabs(dphi2 -dphi1) < M_PI) { - ctrlon -= dphi * (dphi1*f1+dphi2*f2)/2.0; - } - else { - if(dphi1 > 0.0) - fac = M_PI; - else - fac = -M_PI; - fint = f1 + (f2-f1)*(fac-dphi1)/fabs(dphi); - ctrlon -= 0.5*dphi1*(dphi1-fac)*f1 - 0.5*dphi2*(dphi2+fac)*f2 - + 0.5*fac*(dphi1+dphi2)*fint; - } - } - return (ctrlon*RADIUS*RADIUS); -} /* box_ctrlon */ - -/******************************************************************************* - double grid_box_radius(double *x, double *y, double *z, int n); - Find the radius of the grid box, the radius is defined the - maximum distance between any two vertices -*******************************************************************************/ -double grid_box_radius(const double *x, const double *y, const double *z, int n) -{ - double radius; - int i, j; - - radius = 0; - for(i=0; i is - the outward edge normal from vertex to . is the vector - from to . - if Inner produce * > 0, outside, otherwise inside. - inner product value = 0 also treate as inside. -*******************************************************************************/ -int inside_edge(double x0, double y0, double x1, double y1, double x, double y) -{ - const double SMALL = 1.e-12; - double product; - - product = ( x-x0 )*(y1-y0) + (x0-x1)*(y-y0); - return (product<=SMALL) ? 1:0; - -} /* inside_edge */ - - -/* The following is a test program to test subroutines in create_xgrid.c */ - -#ifdef test_create_xgrid - -#include "create_xgrid.h" -#include - -#define D2R (M_PI/180) -#define R2D (180/M_PI) -#define MAXPOINT 1000 - -int main(int argc, char* argv[]) -{ - - double lon1_in[MAXPOINT], lat1_in[MAXPOINT]; - double lon2_in[MAXPOINT], lat2_in[MAXPOINT]; - double x1_in[MAXPOINT], y1_in[MAXPOINT], z1_in[MAXPOINT]; - double x2_in[MAXPOINT], y2_in[MAXPOINT], z2_in[MAXPOINT]; - double lon_out[20], lat_out[20]; - double x_out[20], y_out[20], z_out[20]; - int n1_in, n2_in, n_out, i, j; - int nlon1=0, nlat1=0, nlon2=0, nlat2=0; - int n; - int ntest = 11; - - - for(n=11; n<=ntest; n++) { - - switch (n) { - case 1: - /**************************************************************** - - test clip_2dx2d_great_cirle case 1: - box 1: (20,10), (20,12), (22,12), (22,10) - box 2: (21,11), (21,14), (24,14), (24,11) - out : (21, 12.0018), (22, 12), (22, 11.0033), (21, 11) - - ****************************************************************/ - n1_in = 4; n2_in = 4; - /* first a simple lat-lon grid box to clip another lat-lon grid box */ - lon1_in[0] = 20; lat1_in[0] = 10; - lon1_in[1] = 20; lat1_in[1] = 12; - lon1_in[2] = 22; lat1_in[2] = 12; - lon1_in[3] = 22; lat1_in[3] = 10; - lon2_in[0] = 21; lat2_in[0] = 11; - lon2_in[1] = 21; lat2_in[1] = 14; - lon2_in[2] = 24; lat2_in[2] = 14; - lon2_in[3] = 24; lat2_in[3] = 11; - break; - - case 2: - /**************************************************************** - - test clip_2dx2d_great_cirle case 2: two identical box - box 1: (20,10), (20,12), (22,12), (22,10) - box 2: (20,10), (20,12), (22,12), (22,10) - out : (20,10), (20,12), (22,12), (22,10) - - ****************************************************************/ - lon1_in[0] = 20; lat1_in[0] = 10; - lon1_in[1] = 20; lat1_in[1] = 12; - lon1_in[2] = 22; lat1_in[2] = 12; - lon1_in[3] = 22; lat1_in[3] = 10; - - for(i=0; i 10 ) { - int nxgrid; - int *i1, *j1, *i2, *j2; - double *xarea, *xclon, *xclat, *mask1; - - mask1 = (double *)malloc(nlon1*nlat1*sizeof(double)); - i1 = (int *)malloc(MAXXGRID*sizeof(int)); - j1 = (int *)malloc(MAXXGRID*sizeof(int)); - i2 = (int *)malloc(MAXXGRID*sizeof(int)); - j2 = (int *)malloc(MAXXGRID*sizeof(int)); - xarea = (double *)malloc(MAXXGRID*sizeof(double)); - xclon = (double *)malloc(MAXXGRID*sizeof(double)); - xclat = (double *)malloc(MAXXGRID*sizeof(double)); - - for(i=0; i. -!*********************************************************************** -!> @defgroup grid_mod grid_mod -!> @ingroup mosaic -!> @brief Routines for grid calculations - -module grid_mod -#ifdef use_deprecated_io - -use mpp_mod, only : mpp_root_pe, uppercase, lowercase, FATAL, NOTE, mpp_error -use constants_mod, only : PI, radius -use fms_io_mod, only : get_great_circle_algorithm, get_global_att_value, string, & - field_exist, field_size, read_data -use mosaic_mod, only : get_mosaic_ntiles, get_mosaic_xgrid_size, get_mosaic_grid_sizes, & - get_mosaic_xgrid, calc_mosaic_grid_area, calc_mosaic_grid_great_circle_area - -! the following two use statement are only needed for define_cube_mosaic -use mpp_domains_mod, only : domain2d, mpp_define_mosaic, mpp_get_compute_domain, & - mpp_get_global_domain, domainUG, mpp_pass_SG_to_UG -use mosaic_mod, only : get_mosaic_ncontacts, get_mosaic_contact - -implicit none;private - -! ==== public interfaces ===================================================== -! grid dimension inquiry subroutines -public :: get_grid_ntiles -public :: get_grid_size -! grid geometry inquiry subroutines -public :: get_grid_cell_centers -public :: get_grid_cell_vertices -! grid area inquiry subroutines -public :: get_grid_cell_area -public :: get_grid_comp_area -! decompose cubed sphere domains -- probably does not belong here, but it should -! be in some place available for component models -public :: define_cube_mosaic -! ==== end of public interfaces ============================================== - -!> returns horizontal sizes of the grid -!> @ingroup grid_mod -interface get_grid_size - module procedure get_grid_size_for_all_tiles - module procedure get_grid_size_for_one_tile -end interface -!> returns number of tiles -!> @ingroup grid_mod -interface get_grid_cell_vertices - module procedure get_grid_cell_vertices_1D - module procedure get_grid_cell_vertices_2D - module procedure get_grid_cell_vertices_UG -end interface - -!> @ingroup grid_mod -interface get_grid_cell_centers - module procedure get_grid_cell_centers_1D - module procedure get_grid_cell_centers_2D - module procedure get_grid_cell_centers_UG -end interface - -!> @ingroup grid_mod -interface get_grid_cell_area - module procedure get_grid_cell_area_SG - module procedure get_grid_cell_area_UG -end interface get_grid_cell_area - -!> @ingroup grid_mod -interface get_grid_comp_area - module procedure get_grid_comp_area_SG - module procedure get_grid_comp_area_UG -end interface get_grid_comp_area - -!> @addtogroup grid_mod -!> @{ - -! ==== module constants ====================================================== -character(len=*), parameter :: & - module_name = 'grid_mod' - -! Include variable "version" to be written to log file. -#include - -character(len=*), parameter :: & - grid_dir = 'INPUT/', & !< root directory for all grid files - grid_file = 'INPUT/grid_spec.nc' !< name of the grid spec file - -integer, parameter :: & - MAX_NAME = 256, & !< max length of the variable names - MAX_FILE = 1024, & !< max length of the file names - VERSION_0 = 0, & - VERSION_1 = 1, & - VERSION_2 = 2 - -integer, parameter :: BUFSIZE = 1048576 !< This is used to control memory usage in get_grid_comp_area - !! We may change this to a namelist variable is needed. - -! ==== module variables ====================================================== -integer :: grid_version = -1 -logical :: great_circle_algorithm = .FALSE. -logical :: first_call = .TRUE. - - -contains - -function get_grid_version() - integer :: get_grid_version - - if(first_call) then - great_circle_algorithm = get_great_circle_algorithm() - first_call = .FALSE. - endif - - if(grid_version<0) then - if(field_exist(grid_file, 'geolon_t')) then - grid_version = VERSION_0 - else if(field_exist(grid_file, 'x_T')) then - grid_version = VERSION_1 - else if(field_exist(grid_file, 'ocn_mosaic_file') ) then - grid_version = VERSION_2 - else - call mpp_error(FATAL, module_name//& - & '/get_grid_version: Can''t determine the version of the grid spec:'// & - & ' none of "x_T", "geolon_t", or "ocn_mosaic_file" exist in file "'//trim(grid_file)//'"') - endif - endif - get_grid_version = grid_version -end function get_grid_version - - -! ============================================================================ -! ============================================================================ -!> Returns number of tiles for a given component -subroutine get_grid_ntiles(component,ntiles) - character(len=*) :: component - integer, intent(out) :: ntiles - - ! local vars - character(len=MAX_FILE) :: component_mosaic - - select case (get_grid_version()) - case(VERSION_0,VERSION_1) - ntiles = 1 - case(VERSION_2) - call read_data(grid_file,trim(lowercase(component))//'_mosaic_file',component_mosaic) - ntiles = get_mosaic_ntiles(grid_dir//trim(component_mosaic)) - end select -end subroutine get_grid_ntiles - - -! ============================================================================ -! ============================================================================ -!> Returns size of the grid for each of the tiles -subroutine get_grid_size_for_all_tiles(component,nx,ny) - character(len=*) :: component - integer, intent(inout) :: nx(:),ny(:) - - ! local vars - integer :: siz(4) ! for the size of external fields - character(len=MAX_NAME) :: varname1, varname2 - character(len=MAX_FILE) :: component_mosaic - - varname1 = 'AREA_'//trim(uppercase(component)) - varname2 = trim(lowercase(component))//'_mosaic_file' - - select case (get_grid_version()) - case(VERSION_0,VERSION_1) - call field_size(grid_file, varname1, siz) - nx(1) = siz(1); ny(1)=siz(2) - case(VERSION_2) ! mosaic file - call read_data(grid_file,varname2, component_mosaic) - call get_mosaic_grid_sizes(grid_dir//trim(component_mosaic),nx,ny) - end select -end subroutine get_grid_size_for_all_tiles - - -! ============================================================================ -! ============================================================================ -!> Returns size of the grid for one of the tiles -subroutine get_grid_size_for_one_tile(component,tile,nx,ny) - character(len=*) :: component - integer, intent(in) :: tile - integer, intent(inout) :: nx,ny - - ! local vars - integer, allocatable :: nnx(:), nny(:) - integer :: ntiles - - call get_grid_ntiles(component, ntiles) - if(tile>0.and.tile<=ntiles) then - allocate(nnx(ntiles),nny(ntiles)) - call get_grid_size_for_all_tiles(component,nnx,nny) - nx = nnx(tile); ny = nny(tile) - deallocate(nnx,nny) - else - call mpp_error(FATAL, 'get_grid_size: requested tile index '// & - & trim(string(tile))//' is out of bounds (1:'//trim(string(ntiles))//')') - endif -end subroutine get_grid_size_for_one_tile - -! ============================================================================ -! ============================================================================ -!> Return grid cell area for the specified model component and tile -subroutine get_grid_cell_area_SG(component, tile, cellarea, domain) - character(len=*), intent(in) :: component - integer , intent(in) :: tile - real , intent(inout) :: cellarea(:,:) - type(domain2d) , intent(in), optional :: domain - - ! local vars - integer :: nlon, nlat - real, allocatable :: glonb(:,:), glatb(:,:) - - select case(get_grid_version()) - case(VERSION_0,VERSION_1) - select case(trim(component)) - case('LND') - call read_data(grid_file, 'AREA_LND_CELL', cellarea, & - no_domain=.not.present(domain), domain=domain) - case('ATM','OCN') - call read_data(grid_file, 'AREA_'//trim(uppercase(component)),cellarea,& - no_domain=.not.present(domain),domain=domain) - case default - call mpp_error(FATAL, module_name//'/get_grid_cell_area: Illegal component name "'//trim(component) & - & //'": must be one of ATM, LND, or OCN') - end select - ! convert area to m2 - cellarea = cellarea*4.*PI*radius**2 - case(VERSION_2) - if (present(domain)) then - call mpp_get_compute_domain(domain,xsize=nlon,ysize=nlat) - else - call get_grid_size(component,tile,nlon,nlat) - endif - allocate(glonb(nlon+1,nlat+1),glatb(nlon+1,nlat+1)) - call get_grid_cell_vertices(component, tile, glonb, glatb, domain) - if (great_circle_algorithm) then - call calc_mosaic_grid_great_circle_area(glonb*pi/180.0, glatb*pi/180.0, cellarea) - else - call calc_mosaic_grid_area(glonb*pi/180.0, glatb*pi/180.0, cellarea) - end if - deallocate(glonb,glatb) - end select - -end subroutine get_grid_cell_area_SG - -! ============================================================================ -! ============================================================================ -!> Get the area of the component per grid cell -subroutine get_grid_comp_area_SG(component,tile,area,domain) - character(len=*) :: component - integer, intent(in) :: tile - real, intent(inout) :: area(:,:) - type(domain2d), intent(in), optional :: domain - ! local vars - integer :: n_xgrid_files ! number of exchange grid files in the mosaic - integer :: siz(4), nxgrid - integer :: i,j,m,n - integer, allocatable :: i1(:), j1(:), i2(:), j2(:) - real, allocatable :: xgrid_area(:) - real, allocatable :: rmask(:,:) - character(len=MAX_NAME) :: & - xgrid_name, & ! name of the variable holding xgrid names - tile_name, & ! name of the tile - xgrid_file, & ! name of the current xgrid file - mosaic_name,& ! name of the mosaic - mosaic_file,& - tilefile - character(len=4096) :: attvalue - character(len=MAX_NAME), allocatable :: nest_tile_name(:) - integer :: is,ie,js,je ! boundaries of our domain - integer :: i0, j0 ! offsets for x and y, respectively - integer :: num_nest_tile, ntiles - logical :: is_nest - integer :: found_xgrid_files ! how many xgrid files we actually found in the grid spec - integer :: ibegin, iend, bsize, l - - select case (get_grid_version()) - case(VERSION_0,VERSION_1) - select case(component) - case('ATM') - call read_data(grid_file,'AREA_ATM',area, no_domain=.not.present(domain),domain=domain) - case('OCN') - allocate(rmask(size(area,1),size(area,2))) - call read_data(grid_file,'AREA_OCN',area, no_domain=.not.present(domain),domain=domain) - call read_data(grid_file,'wet', rmask,no_domain=.not.present(domain),domain=domain) - area = area*rmask - deallocate(rmask) - case('LND') - call read_data(grid_file,'AREA_LND',area,no_domain=.not.present(domain),domain=domain) - case default - call mpp_error(FATAL, module_name// & - & '/get_grid_comp_area: Illegal component name "'//trim(component)//'": must be one of ATM, LND, or OCN') - end select - case(VERSION_2) ! mosaic gridspec - select case (component) - case ('ATM') - ! just read the grid cell area and return - call get_grid_cell_area(component,tile,area) - return - case ('LND') - xgrid_name = 'aXl_file' - call read_data(grid_file, 'lnd_mosaic', mosaic_name) - tile_name = trim(mosaic_name)//'_tile'//char(tile+ichar('0')) - case ('OCN') - xgrid_name = 'aXo_file' - call read_data(grid_file, 'ocn_mosaic', mosaic_name) - tile_name = trim(mosaic_name)//'_tile'//char(tile+ichar('0')) - case default - call mpp_error(FATAL, module_name// & - & '/get_grid_comp_area: Illegal component name "'//trim(component)//'": must be one of ATM, LND, or OCN') - end select - ! get the boundaries of the requested domain - if(present(domain)) then - call mpp_get_compute_domain(domain,is,ie,js,je) - i0 = 1-is ; j0=1-js - else - call get_grid_size(component,tile,ie,je) - is = 1 ; i0 = 0 - js = 1 ; j0 = 0 - endif - if (size(area,1)/=ie-is+1.or.size(area,2)/=je-js+1) & - call mpp_error(FATAL, module_name// & - & '/get_grid_comp_area: size of the output argument "area" is not consistent with the domain') - - ! find the nest tile - call read_data(grid_file, 'atm_mosaic', mosaic_name) - call read_data(grid_file,'atm_mosaic_file',mosaic_file) - mosaic_file = grid_dir//trim(mosaic_file) - ntiles = get_mosaic_ntiles(trim(mosaic_file)) - allocate(nest_tile_name(ntiles)) - num_nest_tile = 0 - do n = 1, ntiles - call read_data(mosaic_file, 'gridfiles', tilefile, level=n) - tilefile = grid_dir//trim(tilefile) - if( get_global_att_value(tilefile, "nest_grid", attvalue) ) then - if(trim(attvalue) == "TRUE") then - num_nest_tile = num_nest_tile + 1 - nest_tile_name(num_nest_tile) = trim(mosaic_name)//'_tile'//char(n+ichar('0')) - else if(trim(attvalue) .NE. "FALSE") then - call mpp_error(FATAL, module_name//'/get_grid_comp_area: value of global attribute nest_grid in file'// & - & trim(tilefile)//' should be TRUE of FALSE') - endif - end if - end do - area(:,:) = 0. - if(field_exist(grid_file,xgrid_name)) then - ! get the number of the exchange-grid files - call field_size(grid_file,xgrid_name,siz) - n_xgrid_files = siz(2) - found_xgrid_files = 0 - ! loop through all exchange grid files - do n = 1, n_xgrid_files - ! get the name of the current exchange grid file - call read_data(grid_file,xgrid_name,xgrid_file,level=n) - ! skip the rest of the loop if the name of the current tile isn't found - ! in the file name, but check this only if there is more than 1 tile - if(n_xgrid_files>1) then - if(index(xgrid_file,trim(tile_name))==0) cycle - endif - found_xgrid_files = found_xgrid_files + 1 - !---make sure the atmosphere grid is not a nested grid - is_nest = .false. - do m = 1, num_nest_tile - if(index(xgrid_file, trim(nest_tile_name(m))) .NE. 0) then - is_nest = .true. - exit - end if - end do - if(is_nest) cycle - - ! finally read the exchange grid - nxgrid = get_mosaic_xgrid_size(grid_dir//xgrid_file) - if(nxgrid < BUFSIZE) then - allocate(i1(nxgrid), j1(nxgrid), i2(nxgrid), j2(nxgrid), xgrid_area(nxgrid)) - else - allocate(i1(BUFSIZE), j1(BUFSIZE), i2(BUFSIZE), j2(BUFSIZE), xgrid_area(BUFSIZE)) - endif - ibegin = 1 - do l = 1,nxgrid,BUFSIZE - bsize = min(BUFSIZE, nxgrid-l+1) - iend = ibegin + bsize - 1 - call get_mosaic_xgrid(grid_dir//xgrid_file, i1(1:bsize), j1(1:bsize), i2(1:bsize), j2(1:bsize), & - xgrid_area(1:bsize), ibegin, iend) - ! and sum the exchange grid areas - do m = 1, bsize - i = i2(m); j = j2(m) - if (iie) cycle - if (jje) cycle - area(i+i0,j+j0) = area(i+i0,j+j0) + xgrid_area(m) - end do - ibegin = iend + 1 - enddo - deallocate(i1, j1, i2, j2, xgrid_area) - enddo - if (found_xgrid_files == 0) & - call mpp_error(FATAL, 'get_grid_comp_area: no xgrid files were found for component '// & - & trim(component)//' (mosaic name is '//trim(mosaic_name)//')') - - endif - deallocate(nest_tile_name) - end select ! version - ! convert area to m2 - area = area*4.*PI*radius**2 -end subroutine get_grid_comp_area_SG - -!====================================================================== -subroutine get_grid_cell_area_UG(component, tile, cellarea, SG_domain, UG_domain) - character(len=*), intent(in) :: component - integer , intent(in) :: tile - real , intent(inout) :: cellarea(:) - type(domain2d) , intent(in) :: SG_domain - type(domainUG) , intent(in) :: UG_domain - integer :: is, ie, js, je - real, allocatable :: SG_area(:,:) - - call mpp_get_compute_domain(SG_domain, is, ie, js, je) - allocate(SG_area(is:ie, js:je)) - call get_grid_cell_area_SG(component, tile, SG_area, SG_domain) - call mpp_pass_SG_to_UG(UG_domain, SG_area, cellarea) - deallocate(SG_area) - -end subroutine get_grid_cell_area_UG - -subroutine get_grid_comp_area_UG(component, tile, area, SG_domain, UG_domain) - character(len=*), intent(in) :: component - integer , intent(in) :: tile - real , intent(inout) :: area(:) - type(domain2d) , intent(in) :: SG_domain - type(domainUG) , intent(in) :: UG_domain - integer :: is, ie, js, je - real, allocatable :: SG_area(:,:) - - call mpp_get_compute_domain(SG_domain, is, ie, js, je) - allocate(SG_area(is:ie, js:je)) - call get_grid_comp_area_SG(component, tile, SG_area, SG_domain) - call mpp_pass_SG_to_UG(UG_domain, SG_area, area) - deallocate(SG_area) - -end subroutine get_grid_comp_area_UG - - -! ============================================================================ -! ============================================================================ -!> Returns arrays of global grid cell boundaries for given model component and -!! mosaic tile number. -!! -!> @note In the case of non-lat-lon grid the returned coordinates may have be not so -!! meaningful, by the very nature of such grids. But presumably these 1D coordinate -!! arrays are good enough for diag axis and such. -subroutine get_grid_cell_vertices_1D(component, tile, glonb, glatb) - character(len=*), intent(in) :: component - integer, intent(in) :: tile - real, intent(inout) :: glonb(:),glatb(:) - - integer :: nlon, nlat - integer :: start(4), nread(4) - real, allocatable :: tmp(:,:), x_vert_t(:,:,:), y_vert_t(:,:,:) - character(len=MAX_FILE) :: filename1, filename2 - - call get_grid_size_for_one_tile(component, tile, nlon, nlat) - if (size(glonb(:))/=nlon+1) & - call mpp_error (FATAL, module_name// & - & '/get_grid_cell_vertices_1D: Size of argument "glonb" is not consistent with the grid size') - if (size(glatb(:))/=nlat+1) & - call mpp_error (FATAL, module_name// & - & '/get_grid_cell_vertices_1D: Size of argument "glatb" is not consistent with the grid size') - if(trim(component) .NE. 'ATM' .AND. component .NE. 'LND' .AND. component .NE. 'OCN') then - call mpp_error(FATAL, module_name//'/get_grid_cell_vertices_1D: Illegal component name "'// & - & trim(component)//'": must be one of ATM, LND, or OCN') - endif - - select case(get_grid_version()) - case(VERSION_0) - select case(trim(component)) - case('ATM','LND') - call read_data(grid_file, 'xb'//lowercase(component(1:1)), glonb, no_domain=.true.) - call read_data(grid_file, 'yb'//lowercase(component(1:1)), glatb, no_domain=.true.) - case('OCN') - call read_data(grid_file, "gridlon_vert_t", glonb, no_domain=.true.) - call read_data(grid_file, "gridlat_vert_t", glatb, no_domain=.true.) - end select - case(VERSION_1) - select case(trim(component)) - case('ATM','LND') - call read_data(grid_file, 'xb'//lowercase(component(1:1)), glonb, no_domain=.true.) - call read_data(grid_file, 'yb'//lowercase(component(1:1)), glatb, no_domain=.true.) - case('OCN') - allocate (x_vert_t(nlon,1,2), y_vert_t(1,nlat,2) ) - start = 1; nread = 1 - nread(1) = nlon; nread(2) = 1; start(3) = 1 - call read_data(grid_file, "x_vert_T", x_vert_t(:,:,1), start, nread, no_domain=.TRUE.) - nread(1) = nlon; nread(2) = 1; start(3) = 2 - call read_data(grid_file, "x_vert_T", x_vert_t(:,:,2), start, nread, no_domain=.TRUE.) - - nread(1) = 1; nread(2) = nlat; start(3) = 1 - call read_data(grid_file, "y_vert_T", y_vert_t(:,:,1), start, nread, no_domain=.TRUE.) - nread(1) = 1; nread(2) = nlat; start(3) = 4 - call read_data(grid_file, "y_vert_T", y_vert_t(:,:,2), start, nread, no_domain=.TRUE.) - glonb(1:nlon) = x_vert_t(1:nlon,1,1) - glonb(nlon+1) = x_vert_t(nlon,1,2) - glatb(1:nlat) = y_vert_t(1,1:nlat,1) - glatb(nlat+1) = y_vert_t(1,nlat,2) - deallocate(x_vert_t, y_vert_t) - end select - case(VERSION_2) - ! get the name of the mosaic file for the component - call read_data(grid_file, trim(lowercase(component))//'_mosaic_file', filename1) - filename1=grid_dir//trim(filename1) - ! get the name of the grid file for the component and tile - call read_data(filename1, 'gridfiles', filename2, level=tile) - filename2 = grid_dir//trim(filename2) - - start = 1; nread = 1 - nread(1) = 2*nlon+1 - allocate( tmp(2*nlon+1,1) ) - call read_data(filename2, "x", tmp, start, nread, no_domain=.TRUE.) - glonb(1:nlon+1) = tmp(1:2*nlon+1:2,1) - deallocate(tmp) - allocate(tmp(1,2*nlat+1)) - - start = 1; nread = 1 - nread(2) = 2*nlat+1 - call read_data(filename2, "y", tmp, start, nread, no_domain=.TRUE.) - glatb(1:nlat+1) = tmp(1,1:2*nlat+1:2) - deallocate(tmp) - end select - -end subroutine get_grid_cell_vertices_1D - -! ============================================================================ -! ============================================================================ -!> Returns cell vertices for the specified model component and mosaic tile number -subroutine get_grid_cell_vertices_2D(component, tile, lonb, latb, domain) - character(len=*), intent(in) :: component - integer, intent(in) :: tile - real, intent(inout) :: lonb(:,:),latb(:,:) - type(domain2d), optional, intent(in) :: domain - - ! local vars - character(len=MAX_FILE) :: filename1, filename2 - integer :: nlon, nlat - integer :: i,j - real, allocatable :: buffer(:), tmp(:,:), x_vert_t(:,:,:), y_vert_t(:,:,:) - integer :: is,ie,js,je ! boundaries of our domain - integer :: i0,j0 ! offsets for coordinates - integer :: isg, jsg - integer :: start(4), nread(4) - - call get_grid_size_for_one_tile(component, tile, nlon, nlat) - if (present(domain)) then - call mpp_get_compute_domain(domain,is,ie,js,je) - else - is = 1 ; ie = nlon - js = 1 ; je = nlat - !--- domain normally should be present - call mpp_error (NOTE, module_name//'/get_grid_cell_vertices: domain is not present, global data will be read') - endif - i0 = -is+1; j0 = -js+1 - - ! verify that lonb and latb sizes are consistent with the size of domain - if (size(lonb,1)/=ie-is+2.or.size(lonb,2)/=je-js+2) & - call mpp_error (FATAL, module_name// & - & '/get_grid_cell_vertices: Size of argument "lonb" is not consistent with the domain size') - if (size(latb,1)/=ie-is+2.or.size(latb,2)/=je-js+2) & - call mpp_error (FATAL, module_name// & - & '/get_grid_cell_vertices: Size of argument "latb" is not consistent with the domain size') - if(trim(component) .NE. 'ATM' .AND. component .NE. 'LND' .AND. component .NE. 'OCN') then - call mpp_error(FATAL, module_name//'/get_grid_cell_vertices: Illegal component name "'// & - & trim(component)//'": must be one of ATM, LND, or OCN') - endif - - select case(get_grid_version()) - case(VERSION_0) - select case(component) - case('ATM','LND') - allocate(buffer(max(nlon,nlat)+1)) - ! read coordinates of grid cell vertices - call read_data(grid_file, 'xb'//lowercase(component(1:1)), buffer(1:nlon+1), no_domain=.true.) - do j = js, je+1 - do i = is, ie+1 - lonb(i+i0,j+j0) = buffer(i) - enddo - enddo - call read_data(grid_file, 'yb'//lowercase(component(1:1)), buffer(1:nlat+1), no_domain=.true.) - do j = js, je+1 - do i = is, ie+1 - latb(i+i0,j+j0) = buffer(j) - enddo - enddo - deallocate(buffer) - case('OCN') - if (present(domain)) then - start = 1; nread = 1 - start(1) = is; start(2) = js - nread(1) = ie-is+2; nread(2) = je-js+2 - call read_data(grid_file, 'geolon_vert_t', lonb, start, nread, no_domain=.true. ) - call read_data(grid_file, 'geolat_vert_t', latb, start, nread, no_domain=.true. ) - else - call read_data(grid_file, 'geolon_vert_t', lonb, no_domain=.TRUE. ) - call read_data(grid_file, 'geolat_vert_t', latb, no_domain=.TRUE. ) - endif - end select - case(VERSION_1) - select case(component) - case('ATM','LND') - allocate(buffer(max(nlon,nlat)+1)) - ! read coordinates of grid cell vertices - call read_data(grid_file, 'xb'//lowercase(component(1:1)), buffer(1:nlon+1), no_domain=.true.) - do j = js, je+1 - do i = is, ie+1 - lonb(i+i0,j+j0) = buffer(i) - enddo - enddo - call read_data(grid_file, 'yb'//lowercase(component(1:1)), buffer(1:nlat+1), no_domain=.true.) - do j = js, je+1 - do i = is, ie+1 - latb(i+i0,j+j0) = buffer(j) - enddo - enddo - deallocate(buffer) - case('OCN') - nlon=ie-is+1; nlat=je-js+1 - allocate (x_vert_t(nlon,nlat,4), y_vert_t(nlon,nlat,4) ) - call read_data(grid_file, 'x_vert_T', x_vert_t, no_domain=.not.present(domain), domain=domain ) - call read_data(grid_file, 'y_vert_T', y_vert_t, no_domain=.not.present(domain), domain=domain ) - lonb(1:nlon,1:nlat) = x_vert_t(1:nlon,1:nlat,1) - lonb(nlon+1,1:nlat) = x_vert_t(nlon,1:nlat,2) - lonb(1:nlon,nlat+1) = x_vert_t(1:nlon,nlat,4) - lonb(nlon+1,nlat+1) = x_vert_t(nlon,nlat,3) - latb(1:nlon,1:nlat) = y_vert_t(1:nlon,1:nlat,1) - latb(nlon+1,1:nlat) = y_vert_t(nlon,1:nlat,2) - latb(1:nlon,nlat+1) = y_vert_t(1:nlon,nlat,4) - latb(nlon+1,nlat+1) = y_vert_t(nlon,nlat,3) - deallocate(x_vert_t, y_vert_t) - end select - case(VERSION_2) - ! get the name of the mosaic file for the component - call read_data(grid_file, trim(lowercase(component))//'_mosaic_file', filename1) - filename1=grid_dir//trim(filename1) - ! get the name of the grid file for the component and tile - call read_data(filename1, 'gridfiles', filename2, level=tile) - filename2 = grid_dir//trim(filename2) - if(PRESENT(domain)) then - call mpp_get_global_domain(domain, xbegin=isg, ybegin=jsg) - start = 1; nread = 1 - start(1) = 2*(is-isg+1) - 1; nread(1) = 2*(ie-is)+3 - start(2) = 2*(js-jsg+1) - 1; nread(2) = 2*(je-js)+3 - allocate(tmp(nread(1), nread(2)) ) - call read_data(filename2, 'x', tmp, start, nread, no_domain=.TRUE.) - do j = 1, je-js+2 - do i = 1, ie-is+2 - lonb(i,j) = tmp(2*i-1,2*j-1) - enddo - enddo - call read_data(filename2, 'y', tmp, start, nread, no_domain=.TRUE.) - do j = 1, je-js+2 - do i = 1, ie-is+2 - latb(i,j) = tmp(2*i-1,2*j-1) - enddo - enddo - else - allocate(tmp(2*nlon+1,2*nlat+1)) - call read_data(filename2, 'x', tmp, no_domain=.TRUE.) - do j = js, je+1 - do i = is, ie+1 - lonb(i+i0,j+j0) = tmp(2*i-1,2*j-1) - end do - end do - call read_data(filename2, 'y', tmp, no_domain=.TRUE.) - do j = js, je+1 - do i = is, ie+1 - latb(i+i0,j+j0) = tmp(2*i-1,2*j-1) - end do - end do - endif - deallocate(tmp) - end select - -end subroutine get_grid_cell_vertices_2D - - -subroutine get_grid_cell_vertices_UG(component, tile, lonb, latb, SG_domain, UG_domain) - character(len=*), intent(in) :: component - integer, intent(in) :: tile - real, intent(inout) :: lonb(:,:),latb(:,:) ! The second dimension is 4 - type(domain2d) , intent(in) :: SG_domain - type(domainUG) , intent(in) :: UG_domain - integer :: is, ie, js, je, i, j - real, allocatable :: SG_lonb(:,:), SG_latb(:,:), tmp(:,:,:) - - call mpp_get_compute_domain(SG_domain, is, ie, js, je) - allocate(SG_lonb(is:ie+1, js:je+1)) - allocate(SG_latb(is:ie+1, js:je+1)) - allocate(tmp(is:ie,js:je,4)) - call get_grid_cell_vertices_2D(component, tile, SG_lonb, SG_latb, SG_domain) - do j = js, je - do i = is, ie - tmp(i,j,1) = SG_lonb(i,j) - tmp(i,j,2) = SG_lonb(i+1,j) - tmp(i,j,3) = SG_lonb(i+1,j+1) - tmp(i,j,4) = SG_lonb(i,j+1) - enddo - enddo - call mpp_pass_SG_to_UG(UG_domain, tmp, lonb) - do j = js, je - do i = is, ie - tmp(i,j,1) = SG_latb(i,j) - tmp(i,j,2) = SG_latb(i+1,j) - tmp(i,j,3) = SG_latb(i+1,j+1) - tmp(i,j,4) = SG_latb(i,j+1) - enddo - enddo - call mpp_pass_SG_to_UG(UG_domain, tmp, latb) - - - deallocate(SG_lonb, SG_latb, tmp) - -end subroutine get_grid_cell_vertices_UG - -! ============================================================================ -!> Returns global coordinate arrays fro given model component and mosaic tile number -!! @note In the case of non-lat-lon grid those coordinates may have be not so -!! meaningful, by the very nature of such grids. But presumably these 1D coordinate -!! arrays are good enough for diag axis and such. -subroutine get_grid_cell_centers_1D(component, tile, glon, glat) - character(len=*), intent(in) :: component - integer, intent(in) :: tile - real, intent(inout) :: glon(:),glat(:) - integer :: nlon, nlat - integer :: start(4), nread(4) - real, allocatable :: tmp(:,:) - character(len=MAX_FILE) :: filename1, filename2 - - call get_grid_size_for_one_tile(component, tile, nlon, nlat) - if (size(glon(:))/=nlon) & - call mpp_error (FATAL, module_name// & - & '/get_grid_cell_centers_1D: Size of argument "glon" is not consistent with the grid size') - if (size(glat(:))/=nlat) & - call mpp_error (FATAL, module_name// & - & '/get_grid_cell_centers_1D: Size of argument "glat" is not consistent with the grid size') - if(trim(component) .NE. 'ATM' .AND. component .NE. 'LND' .AND. component .NE. 'OCN') then - call mpp_error(FATAL, module_name//'/get_grid_cell_centers_1D: Illegal component name "'// & - & trim(component)//'": must be one of ATM, LND, or OCN') - endif - - select case(get_grid_version()) - case(VERSION_0) - select case(trim(component)) - case('ATM','LND') - call read_data(grid_file, 'xt'//lowercase(component(1:1)), glon, no_domain=.true.) - call read_data(grid_file, 'yt'//lowercase(component(1:1)), glat, no_domain=.true.) - case('OCN') - call read_data(grid_file, "gridlon_t", glon, no_domain=.true.) - call read_data(grid_file, "gridlat_t", glat, no_domain=.true.) - end select - case(VERSION_1) - select case(trim(component)) - case('ATM','LND') - call read_data(grid_file, 'xt'//lowercase(component(1:1)), glon, no_domain=.true.) - call read_data(grid_file, 'yt'//lowercase(component(1:1)), glat, no_domain=.true.) - case('OCN') - call read_data(grid_file, "grid_x_T", glon, no_domain=.true.) - call read_data(grid_file, "grid_y_T", glat, no_domain=.true.) - end select - case(VERSION_2) - ! get the name of the mosaic file for the component - call read_data(grid_file, trim(lowercase(component))//'_mosaic_file', filename1) - filename1=grid_dir//trim(filename1) - ! get the name of the grid file for the component and tile - call read_data(filename1, 'gridfiles', filename2, level=tile) - filename2 = grid_dir//trim(filename2) - - start = 1; nread = 1 - nread(1) = 2*nlon+1; start(2) = 2 - allocate( tmp(2*nlon+1,1) ) - call read_data(filename2, "x", tmp, start, nread, no_domain=.TRUE.) - glon(1:nlon) = tmp(2:2*nlon:2,1) - deallocate(tmp) - allocate(tmp(1, 2*nlat+1)) - - start = 1; nread = 1 - nread(2) = 2*nlat+1; start(1) = 2 - call read_data(filename2, "y", tmp, start, nread, no_domain=.TRUE.) - glat(1:nlat) = tmp(1,2:2*nlat:2) - deallocate(tmp) - end select - - -end subroutine get_grid_cell_centers_1D - -! ============================================================================ -! ============================================================================ -!> Returns grid cell centers for specified model component and mosaic tile number -subroutine get_grid_cell_centers_2D(component, tile, lon, lat, domain) - character(len=*), intent(in) :: component - integer, intent(in) :: tile - real, intent(inout) :: lon(:,:),lat(:,:) - type(domain2d), intent(in), optional :: domain - ! local vars - character(len=MAX_FILE) :: filename1, filename2 - integer :: nlon, nlat - integer :: i,j - real, allocatable :: buffer(:),tmp(:,:) - integer :: is,ie,js,je ! boundaries of our domain - integer :: i0,j0 ! offsets for coordinates - integer :: isg, jsg - integer :: start(4), nread(4) - - call get_grid_size_for_one_tile(component, tile, nlon, nlat) - if (present(domain)) then - call mpp_get_compute_domain(domain,is,ie,js,je) - else - is = 1 ; ie = nlon - js = 1 ; je = nlat - !--- domain normally should be present - call mpp_error (NOTE, module_name//'/get_grid_cell_centers: domain is not present, global data will be read') - endif - i0 = -is+1; j0 = -js+1 - - ! verify that lon and lat sizes are consistent with the size of domain - if (size(lon,1)/=ie-is+1.or.size(lon,2)/=je-js+1) & - call mpp_error (FATAL, module_name// & - & '/get_grid_cell_centers: Size of array "lon" is not consistent with the domain size') - if (size(lat,1)/=ie-is+1.or.size(lat,2)/=je-js+1) & - call mpp_error (FATAL, module_name// & - & '/get_grid_cell_centers: Size of array "lat" is not consistent with the domain size') - if(trim(component) .NE. 'ATM' .AND. component .NE. 'LND' .AND. component .NE. 'OCN') then - call mpp_error(FATAL, module_name//'/get_grid_cell_vertices: Illegal component name "'// & - & trim(component)//'": must be one of ATM, LND, or OCN') - endif - - select case(get_grid_version()) - case(VERSION_0) - select case (trim(component)) - case('ATM','LND') - allocate(buffer(max(nlon,nlat))) - ! read coordinates of grid cell vertices - call read_data(grid_file, 'xt'//lowercase(component(1:1)), buffer(1:nlon), no_domain=.true.) - do j = js,je - do i = is,ie - lon(i+i0,j+j0) = buffer(i) - enddo - enddo - call read_data(grid_file, 'yt'//lowercase(component(1:1)), buffer(1:nlat), no_domain=.true.) - do j = js,je - do i = is,ie - lat(i+i0,j+j0) = buffer(j) - enddo - enddo - deallocate(buffer) - case('OCN') - call read_data(grid_file, 'geolon_t', lon, no_domain=.not.present(domain), domain=domain ) - call read_data(grid_file, 'geolat_t', lat, no_domain=.not.present(domain), domain=domain ) - end select - case(VERSION_1) - select case(trim(component)) - case('ATM','LND') - allocate(buffer(max(nlon,nlat))) - ! read coordinates of grid cell vertices - call read_data(grid_file, 'xt'//lowercase(component(1:1)), buffer(1:nlon), no_domain=.true.) - do j = js,je - do i = is,ie - lon(i+i0,j+j0) = buffer(i) - enddo - enddo - call read_data(grid_file, 'yt'//lowercase(component(1:1)), buffer(1:nlat), no_domain=.true.) - do j = js,je - do i = is,ie - lat(i+i0,j+j0) = buffer(j) - enddo - enddo - deallocate(buffer) - case('OCN') - call read_data(grid_file, 'x_T', lon, no_domain=.not.present(domain), domain=domain ) - call read_data(grid_file, 'y_T', lat, no_domain=.not.present(domain), domain=domain ) - end select - case(VERSION_2) ! mosaic grid file - ! get the name of the mosaic file for the component - call read_data(grid_file, trim(lowercase(component))//'_mosaic_file', filename1) - filename1=grid_dir//trim(filename1) - ! get the name of the grid file for the component and tile - call read_data(filename1, 'gridfiles', filename2, level=tile) - filename2 = grid_dir//trim(filename2) - if(PRESENT(domain)) then - call mpp_get_global_domain(domain, xbegin=isg, ybegin=jsg) - start = 1; nread = 1 - start(1) = 2*(is-isg+1) - 1; nread(1) = 2*(ie-is)+3 - start(2) = 2*(js-jsg+1) - 1; nread(2) = 2*(je-js)+3 - allocate(tmp(nread(1), nread(2))) - call read_data(filename2, 'x', tmp, start, nread, no_domain=.TRUE.) - do j = 1, je-js+1 - do i = 1, ie-is+1 - lon(i,j) = tmp(2*i,2*j) - enddo - enddo - call read_data(filename2, 'y', tmp, start, nread, no_domain=.TRUE.) - do j = 1, je-js+1 - do i = 1, ie-is+1 - lat(i,j) = tmp(2*i,2*j) - enddo - enddo - else - allocate(tmp(2*nlon+1,2*nlat+1)) - call read_data(filename2, 'x', tmp, no_domain=.TRUE.) - do j = js,je - do i = is,ie - lon(i+i0,j+j0) = tmp(2*i,2*j) - end do - end do - call read_data(filename2, 'y', tmp, no_domain=.TRUE.) - do j = js,je - do i = is,ie - lat(i+i0,j+j0) = tmp(2*i,2*j) - end do - end do - deallocate(tmp) - endif - end select - -end subroutine get_grid_cell_centers_2D - -subroutine get_grid_cell_centers_UG(component, tile, lon, lat, SG_domain, UG_domain) - character(len=*), intent(in) :: component - integer, intent(in) :: tile - real, intent(inout) :: lon(:),lat(:) - type(domain2d) , intent(in) :: SG_domain - type(domainUG) , intent(in) :: UG_domain - integer :: is, ie, js, je - real, allocatable :: SG_lon(:,:), SG_lat(:,:) - - call mpp_get_compute_domain(SG_domain, is, ie, js, je) - allocate(SG_lon(is:ie, js:je)) - allocate(SG_lat(is:ie, js:je)) - call get_grid_cell_centers_2D(component, tile, SG_lon, SG_lat, SG_domain) - call mpp_pass_SG_to_UG(UG_domain, SG_lon, lon) - call mpp_pass_SG_to_UG(UG_domain, SG_lat, lat) - deallocate(SG_lon, SG_lat) - -end subroutine get_grid_cell_centers_UG - -! ============================================================================ -! ============================================================================ -! this subroutine probably does not belong in the grid_mod -!> Given a model component, a layout, and (optionally) a halo size, returns a -!! domain for current processor -subroutine define_cube_mosaic ( component, domain, layout, halo, maskmap ) - character(len=*) , intent(in) :: component - type(domain2d) , intent(inout) :: domain - integer , intent(in) :: layout(2) - integer, optional, intent(in) :: halo - logical, optional, intent(in) :: maskmap(:,:,:) - - ! ---- local constants - - ! ---- local vars - character(len=MAX_NAME) :: varname - character(len=MAX_FILE + len(grid_dir)) :: mosaic_file - integer :: ntiles ! number of tiles - integer :: ncontacts ! number of contacts between mosaic tiles - integer :: n - integer :: ng, pe_pos, npes ! halo size - integer, allocatable :: nlon(:), nlat(:), global_indices(:,:) - integer, allocatable :: pe_start(:), pe_end(:), layout_2d(:,:) - integer, allocatable :: tile1(:),tile2(:) - integer, allocatable :: is1(:),ie1(:),js1(:),je1(:) - integer, allocatable :: is2(:),ie2(:),js2(:),je2(:) - - call get_grid_ntiles(component,ntiles) - allocate(nlon(ntiles), nlat(ntiles)) - allocate(global_indices(4,ntiles)) - allocate(pe_start(ntiles),pe_end(ntiles)) - allocate(layout_2d(2,ntiles)) - call get_grid_size(component,nlon,nlat) - - pe_pos = mpp_root_pe() - do n = 1, ntiles - global_indices(:,n) = (/ 1, nlon(n), 1, nlat(n) /) - layout_2d (:,n) = layout - if(present(maskmap)) then - npes = count(maskmap(:,:,n)) - else - npes = layout(1)*layout(2) - endif - pe_start(n) = pe_pos - pe_end (n) = pe_pos + npes - 1 - pe_pos = pe_end(n) + 1 - enddo - - varname=trim(lowercase(component))//'_mosaic_file' - call read_data(grid_file,varname,mosaic_file(1:MAX_FILE)) - mosaic_file = grid_dir//mosaic_file(1:MAX_FILE) - - ! get the contact information from mosaic file - ncontacts = get_mosaic_ncontacts(mosaic_file) - allocate(tile1(ncontacts),tile2(ncontacts)) - allocate(is1(ncontacts),ie1(ncontacts),js1(ncontacts),je1(ncontacts)) - allocate(is2(ncontacts),ie2(ncontacts),js2(ncontacts),je2(ncontacts)) - call get_mosaic_contact(mosaic_file, tile1, tile2, & - is1, ie1, js1, je1, is2, ie2, js2, je2) - - ng = 0 - if(present(halo)) ng = halo - ! create the domain2d variable - call mpp_define_mosaic ( global_indices, layout_2d, domain, & - ntiles, ncontacts, tile1, tile2, & - is1, ie1, js1, je1, & - is2, ie2, js2, je2, & - pe_start=pe_start, pe_end=pe_end, symmetry=.true., & - shalo = ng, nhalo = ng, whalo = ng, ehalo = ng, & - maskmap = maskmap, & - name = trim(component)//'Cubic-Sphere Grid' ) - - deallocate(nlon,nlat,global_indices,pe_start,pe_end,layout_2d) - deallocate(tile1,tile2) - deallocate(is1,ie1,js1,je1) - deallocate(is2,ie2,js2,je2) - -end subroutine define_cube_mosaic -#endif -end module grid_mod -!> @} -! close documentation grouping diff --git a/mosaic/interp.c b/mosaic/interp.c deleted file mode 100644 index 6ead747eda..0000000000 --- a/mosaic/interp.c +++ /dev/null @@ -1,394 +0,0 @@ -/*********************************************************************** - * GNU Lesser General Public License - * - * This file is part of the GFDL Flexible Modeling System (FMS). - * - * FMS 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. - * - * FMS 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 Lesser General Public - * License along with FMS. If not, see . - **********************************************************************/ -#include -#include -#include -#include "mosaic_util.h" -#include "interp.h" -#include "create_xgrid.h" - -/** \file - * \ingroup mosaic - * \brief Grid interpolation functions for use in @ref mosaic_mod - */ - -/********************************************************************* - void cublic_spline_sp(size1, size2, grid1, grid2, data1, data2) - - Calculate a shape preserving cubic spline. Monotonicity is ensured over each subinterval - unlike classic cubic spline interpolation. - It will be used to interpolation data in 1-D space. - - INPUT Arguments: - grid1: grid for input data grid. - grid2: grid for output data grid. - size1: size of input grid. - size2: size of output grid. - data1: input data associated with grid1. - - OUTPUT ARGUMENTS: - data2: output data associated with grid2. (OUTPUT) - -*********************************************************************/ - -void cubic_spline_sp(int size1, int size2, const double *grid1, const double *grid2, const double *data1, - double *data2 ) -{ - double *delta=NULL, *d=NULL, *dh=NULL, *b=NULL, *c = NULL; - double s, w1, w2, p; - int i, k, n, klo, khi, kmax; - - for(i=1; i grid1[size1-1]) error_handler("cubic_spline_sp: grid2 lies outside grid1"); - } - - if(size1 < 2) error_handler("cubic_spline_sp: the size of input grid should be at least 2"); - if(size1 == 2) { /* when size1 is 2, it just reduced to a linear interpolation */ - p = (data1[1]-data1[0])/(grid1[1]-grid1[0]); - for(i=0; i< size2; i++) data2[i] = p*(grid2[i] - grid1[0]) + data1[0]; - return; - } - delta = (double *)malloc((size1-1)*sizeof(double)); - dh = (double *)malloc((size1-1)*sizeof(double)); - d = (double *)malloc(size1*sizeof(double)); - for(k=0;k 0.0 ) { - w1 = 2.0*dh[k] + dh[k-1]; - w2 = dh[k] + 2.0*dh[k-1]; - d[k] = (w1+w2)/(w1/delta[k-1]+w2/delta[k]); - } - else { - d[k] = 0.0; - } - } - /* - End slopes - */ - kmax = size1-1; - d[0] = ((2.0*dh[0] + dh[1])*delta[0] - dh[0]*delta[1])/(dh[0]+dh[1]); - - if ( d[0]*delta[0] < 0.0 ) { - d[0] = 0.0; - } - else { - if ( delta[0]*delta[1] < 0.0 && fabs(d[0]) > fabs(3.0*delta[0])) { - d[0]=3.0*delta[0]; - } - } - - d[kmax] = ((2.0*dh[kmax-1] + dh[kmax-2])*delta[kmax-1] - dh[kmax-1]*delta[kmax-2])/(dh[kmax-1]+dh[kmax-2]); - if ( d[kmax]*delta[kmax-1] < 0.0 ) { - d[kmax] = 0.0; - } - else { - if ( delta[kmax-1]*delta[kmax-2] < 0.0 && fabs(d[kmax]) > fabs(3.0*delta[kmax-1])) { - d[kmax]=3.0*delta[kmax-1]; - } - } - - /* Precalculate coefficients */ - b = (double *)malloc((size1-1)*sizeof(double)); - c = (double *)malloc((size1-1)*sizeof(double)); - for (k=0; k grid1[size1-1]) error_handler("cubic_spline: grid2 lies outside grid1"); - } - - if(size1 < 2) error_handler("cubic_spline: the size of input grid should be at least 2"); - if(size1 == 2) { /* when size1 is 2, it just reduced to a linear interpolation */ - p = (data1[1]-data1[0])/(grid1[1]-grid1[0]); - for(i=0; i< size2; i++) data2[i] = p*(grid2[i] - grid1[0]) + data1[0]; - return; - } - y2 = (double *)malloc(size1*sizeof(double)); - u = (double *)malloc(size1*sizeof(double)); - if (yp1 >.99e30) { - y2[0]=0.; - u[0]=0.; - } - else { - y2[0]=-0.5; - u[0]=(3./(grid1[1]-grid1[0]))*((data1[1]-data1[0])/(grid1[1]-grid1[0])-yp1); - } - - for(i=1; i .99e30) { - qn=0.; - un=0.; - } - else { - qn=0.5; - un=(3./(grid1[size1-1]-grid1[size1-2]))*(ypn-(data1[size1-1]-data1[size1-2])/(grid1[size1-1]-grid1[size1-2])); - } - - y2[size1-1]=(un-qn*u[size1-2])/(qn*y2[size1-2]+1.); - - for(k=size1-2; k>=0; k--) y2[k] = y2[k]*y2[k+1]+u[k]; - - /* interpolate data onto grid2 */ - for(k=0; k grid2[0] ) error_handler("interp.c: grid2 lies outside grid1"); - if (grid1[nk1-1] < grid2[nk2-1] ) error_handler("interp.c: grid2 lies outside grid1"); - - for(k=0; k. - **********************************************************************/ -#ifndef INTERP_H_ -#define INTERP_H_ -/********************************************************************* - interp.h - This header files contains defition of some interpolation routine (1-D or 2-D). - contact: Zhi.Liang@noaa.gov -*********************************************************************/ -void cubic_spline_sp(int size1, int size2, const double *grid1, const double *grid2, const double *data1, - double *data2 ); - -void cubic_spline(int size1, int size2, const double *grid1, const double *grid2, const double *data1, - double *data2, double yp1, double ypn ); - -void conserve_interp(int nx_src, int ny_src, int nx_dst, int ny_dst, const double *x_src, - const double *y_src, const double *x_dst, const double *y_dst, - const double *mask_src, const double *data_src, double *data_dst ); - -void conserve_interp_great_circle(int nx_src, int ny_src, int nx_dst, int ny_dst, const double *x_src, - const double *y_src, const double *x_dst, const double *y_dst, - const double *mask_src, const double *data_src, double *data_dst ); - -void linear_vertical_interp(int nx, int ny, int nk1, int nk2, const double *grid1, const double *grid2, - double *data1, double *data2); - -#endif diff --git a/mosaic/mosaic.F90 b/mosaic/mosaic.F90 deleted file mode 100644 index eb8a698de4..0000000000 --- a/mosaic/mosaic.F90 +++ /dev/null @@ -1,497 +0,0 @@ -!*********************************************************************** -!* GNU Lesser General Public License -!* -!* This file is part of the GFDL Flexible Modeling System (FMS). -!* -!* FMS 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. -!* -!* FMS 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 Lesser General Public -!* License along with FMS. If not, see . -!*********************************************************************** -!> @defgroup mosaic_mod mosaic_mod -!> @ingroup mosaic -!> @brief Implements some utility routines to read mosaic information. -!> @author Zhi Liang -!> Implements some utility routines to read mosaic information. -!! The information includes number of tiles and contacts in the mosaic, -!! mosaic grid resolution of each tile, mosaic contact information, mosaic exchange -!! grid information. Each routine will call a C-version routine to get these information. - -!> @addtogroup mosaic_mod -!> @{ -module mosaic_mod -#ifdef use_deprecated_io - -use mpp_mod, only : mpp_error, FATAL, mpp_pe, mpp_root_pe -use mpp_io_mod, only : MPP_MULTI -use fms_io_mod, only : dimension_size, field_exist, read_data, read_compressed -use constants_mod, only : PI, RADIUS - -implicit none -private - -character(len=*), parameter :: & - grid_dir = 'INPUT/' !< root directory for all grid files - -integer, parameter :: & - MAX_NAME = 256, & !< max length of the variable names - MAX_FILE = 1024, & !< max length of the file names - X_REFINE = 2, & !< supergrid size/model grid size in x-direction - Y_REFINE = 2 !< supergrid size/model grid size in y-direction - -! --- public interface - -public :: get_mosaic_ntiles -public :: get_mosaic_ncontacts -public :: get_mosaic_grid_sizes -public :: get_mosaic_contact -public :: get_mosaic_xgrid_size -public :: get_mosaic_xgrid -public :: calc_mosaic_grid_area -public :: calc_mosaic_grid_great_circle_area -public :: is_inside_polygon - -logical :: module_is_initialized = .true. -!--- external c routines -external get_grid_area, get_grid_great_circle_area, grad_c2l, calc_c2l_grid_info - -! Include variable "version" to be written to log file. -#include - -contains - -!####################################################################### - -!> @brief Initialize the mosaic_mod. -!! -!! Initialization routine for the mosaic module. It writes the -!! version information to the log file. -subroutine mosaic_init() - - if (module_is_initialized) return - module_is_initialized = .TRUE. - -!--------- write version number and namelist ------------------ - -end subroutine mosaic_init - -!############################################################################### - - !> @return integer for exchange grid size of mosaic xgrid file. - function get_mosaic_xgrid_size(xgrid_file) - character(len=*), intent(in) :: xgrid_file !< File that contains exchange grid information - integer :: get_mosaic_xgrid_size - - get_mosaic_xgrid_size = dimension_size(xgrid_file, "ncells", no_domain=.TRUE.) - - return - - end function get_mosaic_xgrid_size - -!############################################################################### - !> Get exchange grid information from mosaic xgrid file. - !! - !>
Example usage: - !! @code{.F90} - !! call get_mosaic_xgrid(xgrid_file, nxgrid, i1, j1, i2, j2, area) - !! @endcode - subroutine get_mosaic_xgrid(xgrid_file, i1, j1, i2, j2, area, ibegin, iend) - character(len=*), intent(in) :: xgrid_file !< The file that contains exchange grid information. - integer, intent(inout) :: i1(:), j1(:) !< i and j-index in grid 1 of exchange field - integer, intent(inout) :: i2(:), j2(:) !< i and j-index in grid 2 of exchange field - real, intent(inout) :: area(:) !< area of the exchange grid. The area is sclaed to - !! represent unit earth area. - integer, optional, intent(in) :: ibegin, iend - - integer :: start(4), nread(4), istart - real, dimension(2, size(i1(:))) :: tile1_cell, tile2_cell - integer :: nxgrid, n - real :: garea - real :: get_global_area; - - garea = get_global_area(); - - ! When start and nread present, make sure nread(1) is the same as the size of the data - if(present(ibegin) .and. present(iend)) then - istart = ibegin - nxgrid = iend - ibegin + 1 - if(nxgrid .NE. size(i1(:))) call mpp_error(FATAL, "get_mosaic_xgrid: nxgrid .NE. size(i1(:))") - if(nxgrid .NE. size(j1(:))) call mpp_error(FATAL, "get_mosaic_xgrid: nxgrid .NE. size(j1(:))") - if(nxgrid .NE. size(i2(:))) call mpp_error(FATAL, "get_mosaic_xgrid: nxgrid .NE. size(i2(:))") - if(nxgrid .NE. size(j2(:))) call mpp_error(FATAL, "get_mosaic_xgrid: nxgrid .NE. size(j2(:))") - if(nxgrid .NE. size(area(:))) call mpp_error(FATAL, "get_mosaic_xgrid: nxgrid .NE. size(area(:))") - else - istart = 1 - nxgrid = size(i1(:)) - endif - - start = 1; nread = 1 - start(1) = istart; nread(1) = nxgrid - call read_compressed(xgrid_file, 'xgrid_area', area, start=start, nread=nread, threading=MPP_MULTI) - start = 1; nread = 1 - nread(1) = 2 - start(2) = istart; nread(2) = nxgrid - call read_compressed(xgrid_file, 'tile1_cell', tile1_cell, start=start, nread=nread, threading=MPP_MULTI) - call read_compressed(xgrid_file, 'tile2_cell', tile2_cell, start=start, nread=nread, threading=MPP_MULTI) - - do n = 1, nxgrid - i1(n) = int(tile1_cell(1,n)) - j1(n) = int(tile1_cell(2,n)) - i2(n) = int(tile2_cell(1,n)) - j2(n) = int(tile2_cell(2,n)) - area(n) = area(n)/garea - end do - - return - - end subroutine get_mosaic_xgrid - - !############################################################################### - - !> Get number of tiles in the mosaic_file. - !! - !! - !!
Example usage: - !! @code{.F90} - !! ntiles = get_mosaic_ntiles( mosaic_file) - !! @endcode - function get_mosaic_ntiles(mosaic_file) - character(len=*), intent(in) :: mosaic_file !< The file that contains mosaic information. - integer :: get_mosaic_ntiles - - get_mosaic_ntiles = dimension_size(mosaic_file, "ntiles") - - return - - end function get_mosaic_ntiles - - !############################################################################### - - !> Get number of contacts in the mosaic_file. - !! - !>
Example usage: - !! @code{.F90} - !! ntiles = get_mosaic_ncontacts( mosaic_file) - !! @endcode - function get_mosaic_ncontacts( mosaic_file) - character(len=*), intent(in) :: mosaic_file !< The file that contains mosaic information. - integer :: get_mosaic_ncontacts - - if(field_exist(mosaic_file, "contacts") ) then - get_mosaic_ncontacts = dimension_size(mosaic_file, "ncontact", no_domain=.TRUE.) - else - get_mosaic_ncontacts = 0 - endif - - return - - end function get_mosaic_ncontacts - - !############################################################################### - - !> Get grid size of each tile from mosaic_file - subroutine get_mosaic_grid_sizes( mosaic_file, nx, ny) - character(len=*), intent(in) :: mosaic_file !< The file that contains mosaic information. - integer, dimension(:), intent(inout) :: nx !< List of grid size in x-direction of each tile. - integer, dimension(:), intent(inout) :: ny !< List of grid size in y-direction of each tile. - - character(len=MAX_FILE) :: gridfile - integer :: ntiles, n - - ntiles = get_mosaic_ntiles(mosaic_file) - if(ntiles .NE. size(nx(:)) .OR. ntiles .NE. size(ny(:)) ) then - call mpp_error(FATAL, "get_mosaic_grid_sizes: size of nx/ny does not equal to ntiles") - endif - do n = 1, ntiles - call read_data(mosaic_file, 'gridfiles', gridfile, level=n) - gridfile = grid_dir//trim(gridfile) - nx(n) = dimension_size(gridfile, "nx") - ny(n) = dimension_size(gridfile, "ny") - if(mod(nx(n),x_refine) .NE. 0) call mpp_error(FATAL, "get_mosaic_grid_sizes: nx is not divided by x_refine"); - if(mod(ny(n),y_refine) .NE. 0) call mpp_error(FATAL, "get_mosaic_grid_sizes: ny is not divided by y_refine"); - nx(n) = nx(n)/x_refine; - ny(n) = ny(n)/y_refine; - enddo - - return - - end subroutine get_mosaic_grid_sizes - - !############################################################################### - - !> Get contact information from mosaic_file - subroutine get_mosaic_contact( mosaic_file, tile1, tile2, istart1, iend1, jstart1, jend1, & - istart2, iend2, jstart2, jend2) - character(len=*), intent(in) :: mosaic_file !< File that contains mosaic information - integer, dimension(:), intent(inout) :: tile1 !< list tile number in tile 1 of each contact - integer, dimension(:), intent(inout) :: tile2 !< list tile number in tile 2 of each contact - integer, dimension(:), intent(inout) :: istart1!< list starting i-index in tile 1 of each contact - integer, dimension(:), intent(inout) :: iend1 !< list ending i-index in tile 1 of each contact - integer, dimension(:), intent(inout) :: jstart1!< list starting j-index in tile 1 of each contact - integer, dimension(:), intent(inout) :: jend1 !< list ending j-index in tile 1 of each contact - integer, dimension(:), intent(inout) :: istart2!< list starting i-index in tile 2 of each contact - integer, dimension(:), intent(inout) :: iend2 !< list ending i-index in tile 2 of each contact - integer, dimension(:), intent(inout) :: jstart2!< list starting j-index in tile 2 of each contact - integer, dimension(:), intent(inout) :: jend2 !< list ending j-index in tile 2 of each contact - character(len=MAX_NAME), allocatable :: gridtiles(:) - character(len=MAX_NAME) :: contacts - character(len=MAX_NAME) :: strlist(8) - integer :: ntiles, n, m, ncontacts, nstr, ios - integer :: i1_type, j1_type, i2_type, j2_type - logical :: found - - ntiles = get_mosaic_ntiles(mosaic_file) - allocate(gridtiles(ntiles)) - do n = 1, ntiles - call read_data(mosaic_file, 'gridtiles', gridtiles(n), level=n) - enddo - - ncontacts = get_mosaic_ncontacts(mosaic_file) - - do n = 1, ncontacts - call read_data(mosaic_file, "contacts", contacts, level=n) - nstr = parse_string(contacts, ":", strlist) - if(nstr .NE. 4) call mpp_error(FATAL, & - "mosaic_mod(get_mosaic_contact): number of elements in contact seperated by :/:: should be 4") - found = .false. - do m = 1, ntiles - if(trim(gridtiles(m)) == trim(strlist(2)) ) then !found the tile name - found = .true. - tile1(n) = m - exit - endif - enddo - - if(.not.found) call mpp_error(FATAL, & - "mosaic_mod(get_mosaic_contact):the first tile name specified in contact is not found in tile list") - - found = .false. - do m = 1, ntiles - if(trim(gridtiles(m)) == trim(strlist(4)) ) then !found the tile name - found = .true. - tile2(n) = m - exit - endif - enddo - - if(.not.found) call mpp_error(FATAL, & - "mosaic_mod(get_mosaic_contact):the second tile name specified in contact is not found in tile list") - - call read_data(mosaic_file, "contact_index", contacts, level=n) - nstr = parse_string(contacts, ":,", strlist) - if(nstr .NE. 8) then - if(mpp_pe()==mpp_root_pe()) then - print*, "nstr is ", nstr - print*, "contacts is ", contacts - do m = 1, nstr - print*, "strlist is ", trim(strlist(m)) - enddo - endif - call mpp_error(FATAL, & - "mosaic_mod(get_mosaic_contact): number of elements in contact_index seperated by :/, should be 8") - endif - read(strlist(1), *, iostat=ios) istart1(n) - if(ios .NE. 0) call mpp_error(FATAL, & - "mosaic_mod(get_mosaic_contact): Error in reading istart1") - read(strlist(2), *, iostat=ios) iend1(n) - if(ios .NE. 0) call mpp_error(FATAL, & - "mosaic_mod(get_mosaic_contact): Error in reading iend1") - read(strlist(3), *, iostat=ios) jstart1(n) - if(ios .NE. 0) call mpp_error(FATAL, & - "mosaic_mod(get_mosaic_contact): Error in reading jstart1") - read(strlist(4), *, iostat=ios) jend1(n) - if(ios .NE. 0) call mpp_error(FATAL, & - "mosaic_mod(get_mosaic_contact): Error in reading jend1") - read(strlist(5), *, iostat=ios) istart2(n) - if(ios .NE. 0) call mpp_error(FATAL, & - "mosaic_mod(get_mosaic_contact): Error in reading istart2") - read(strlist(6), *, iostat=ios) iend2(n) - if(ios .NE. 0) call mpp_error(FATAL, & - "mosaic_mod(get_mosaic_contact): Error in reading iend2") - read(strlist(7), *, iostat=ios) jstart2(n) - if(ios .NE. 0) call mpp_error(FATAL, & - "mosaic_mod(get_mosaic_contact): Error in reading jstart2") - read(strlist(8), *, iostat=ios) jend2(n) - if(ios .NE. 0) call mpp_error(FATAL, & - "mosaic_mod(get_mosaic_contact): Error in reading jend2") - - i1_type = transfer_to_model_index(istart1(n), iend1(n), x_refine) - j1_type = transfer_to_model_index(jstart1(n), jend1(n), y_refine) - i2_type = transfer_to_model_index(istart2(n), iend2(n), x_refine) - j2_type = transfer_to_model_index(jstart2(n), jend2(n), y_refine) - - if( i1_type == 0 .AND. j1_type == 0 ) call mpp_error(FATAL, & - "mosaic_mod(get_mosaic_contact): istart1==iend1 and jstart1==jend1") - if( i2_type == 0 .AND. j2_type == 0 ) call mpp_error(FATAL, & - "mosaic_mod(get_mosaic_contact): istart2==iend2 and jstart2==jend2") - if( i1_type + j1_type .NE. i2_type + j2_type ) call mpp_error(FATAL, & - "mosaic_mod(get_mosaic_contact): It is not a line or overlap contact") - - enddo - - deallocate(gridtiles) - - end subroutine get_mosaic_contact - -function transfer_to_model_index(istart, iend, refine_ratio) - integer, intent(inout) :: istart, iend - integer :: refine_ratio - integer :: transfer_to_model_index - integer :: istart_in, iend_in - - istart_in = istart - iend_in = iend - - if( istart_in == iend_in ) then - transfer_to_model_index = 0 - istart = (istart_in + 1)/refine_ratio - iend = istart - else - transfer_to_model_index = 1 - if( iend_in > istart_in ) then - istart = istart_in + 1 - iend = iend_in - else - istart = istart_in - iend = iend_in + 1 - endif - if( mod(istart, refine_ratio) .NE. 0 .OR. mod(iend,refine_ratio) .NE. 0) call mpp_error(FATAL, & - "mosaic_mod(transfer_to_model_index): mismatch between refine_ratio and istart/iend") - istart = istart/refine_ratio - iend = iend/refine_ratio - - endif - - return - -end function transfer_to_model_index - - !############################################################################### - - !> @brief Calculate grid cell area. - !! - !> Calculate the grid cell area. The purpose of this routine is to make - !! sure the consistency between model grid area and exchange grid area. - subroutine calc_mosaic_grid_area(lon, lat, area) - real, dimension(:,:), intent(in) :: lon !< geographical longitude of grid cell vertices - real, dimension(:,:), intent(in) :: lat !< geographical latitude of grid cell vertices - real, dimension(:,:), intent(inout) :: area !< grid cell area - integer :: nlon, nlat - - nlon = size(area,1) - nlat = size(area,2) - ! make sure size of lon, lat and area are consitency - if( size(lon,1) .NE. nlon+1 .OR. size(lat,1) .NE. nlon+1 ) & - call mpp_error(FATAL, "mosaic_mod: size(lon,1) and size(lat,1) should equal to size(area,1)+1") - if( size(lon,2) .NE. nlat+1 .OR. size(lat,2) .NE. nlat+1 ) & - call mpp_error(FATAL, "mosaic_mod: size(lon,2) and size(lat,2) should equal to size(area,2)+1") - - call get_grid_area( nlon, nlat, lon, lat, area) - - end subroutine calc_mosaic_grid_area - - !############################################################################### - - !> Calculate grid cell area using great circle algorithm. - !! - !> Calculate the grid cell area. The purpose of this routine is to make - !! sure the consistency between model grid area and exchange grid area. - subroutine calc_mosaic_grid_great_circle_area(lon, lat, area) - real, dimension(:,:), intent(in) :: lon !< Geographical longitude of grid cell vertices. - real, dimension(:,:), intent(in) :: lat !< Geographical latitude of grid cell vertices. - real, dimension(:,:), intent(inout) :: area !< grid cell area - integer :: nlon, nlat - - - nlon = size(area,1) - nlat = size(area,2) - ! make sure size of lon, lat and area are consitency - if( size(lon,1) .NE. nlon+1 .OR. size(lat,1) .NE. nlon+1 ) & - call mpp_error(FATAL, "mosaic_mod: size(lon,1) and size(lat,1) should equal to size(area,1)+1") - if( size(lon,2) .NE. nlat+1 .OR. size(lat,2) .NE. nlat+1 ) & - call mpp_error(FATAL, "mosaic_mod: size(lon,2) and size(lat,2) should equal to size(area,2)+1") - - call get_grid_great_circle_area( nlon, nlat, lon, lat, area) - - end subroutine calc_mosaic_grid_great_circle_area - - !##################################################################### - !> This function check if a point (lon1,lat1) is inside a polygon (lon2(:), lat2(:)) - !! lon1, lat1, lon2, lat2 are in radians. - function is_inside_polygon(lon1, lat1, lon2, lat2 ) - real, intent(in) :: lon1, lat1 - real, intent(in) :: lon2(:), lat2(:) - logical :: is_inside_polygon - integer :: npts, isinside - integer :: inside_a_polygon - - npts = size(lon2(:)) - - isinside = inside_a_polygon(lon1, lat1, npts, lon2, lat2) - if(isinside == 1) then - is_inside_polygon = .TRUE. - else - is_inside_polygon = .FALSE. - endif - - return - - end function is_inside_polygon - - function parse_string(string, set, value) - character(len=*), intent(in) :: string - character(len=*), intent(in) :: set - character(len=*), intent(out) :: value(:) - integer :: parse_string - integer :: nelem, length, first, last - - nelem = size(value(:)) - length = len_trim(string) - - first = 1; last = 0 - parse_string = 0 - - do while(first .LE. length) - parse_string = parse_string + 1 - if(parse_string>nelem) then - call mpp_error(FATAL, "mosaic_mod(parse_string) : number of element is greater than size(value(:))") - endif - last = first - 1 + scan(string(first:length), set) - if(last == first-1 ) then ! not found, end of string - value(parse_string) = string(first:length) - exit - else - if(last <= first) then - call mpp_error(FATAL, "mosaic_mod(parse_string) : last <= first") - endif - value(parse_string) = string(first:(last-1)) - first = last + 1 - ! scan to make sure the next is not the character in the set - do while (first == last+1) - last = first - 1 + scan(string(first:length), set) - if(last == first) then - first = first+1 - else - exit - endif - end do - endif - enddo - - return - - end function parse_string -#endif -end module mosaic_mod - - -!> @} -! close documentation grouping diff --git a/mosaic/mosaic_util.c b/mosaic/mosaic_util.c deleted file mode 100644 index c37f799f18..0000000000 --- a/mosaic/mosaic_util.c +++ /dev/null @@ -1,1368 +0,0 @@ -/*********************************************************************** - * GNU Lesser General Public License - * - * This file is part of the GFDL Flexible Modeling System (FMS). - * - * FMS 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. - * - * FMS 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 Lesser General Public - * License along with FMS. If not, see . - **********************************************************************/ -#include -#include -#include -#include -#ifdef use_libMPI -#include -#endif -#include "mosaic_util.h" -#include "constant.h" - -#define HPI (0.5*M_PI) -#define TPI (2.0*M_PI) -#define TOLORENCE (1.e-6) -#define EPSLN8 (1.e-8) -#define EPSLN10 (1.e-10) -#define EPSLN15 (1.e-15) -#define EPSLN30 (1.e-30) - -/** \file - * \ingroup mosaic - * \brief Error handling and other general utilities for @ref mosaic_mod - */ - -/*********************************************************** - void error_handler(char *str) - error handler: will print out error message and then abort -***********************************************************/ - -void error_handler(const char *msg) -{ - fprintf(stderr, "FATAL Error: %s\n", msg ); -#ifdef use_libMPI - MPI_Abort(MPI_COMM_WORLD, -1); -#else - exit(1); -#endif -} /* error_handler */ - -/********************************************************************* - - int nearest_index(double value, const double *array, int ia) - - return index of nearest data point within "array" corresponding to "value". - if "value" is outside the domain of "array" then nearest_index = 0 - or = size(array)-1 depending on whether array(0) or array(ia-1) is - closest to "value" - - Arguments: - value: arbitrary data...same units as elements in "array" - array: array of data points (must be monotonically increasing) - ia : size of array. - -********************************************************************/ -int nearest_index(double value, const double *array, int ia) -{ - int index, i; - int keep_going; - - for(i=1; i array[ia-1]) - index = ia-1; - else - { - i=0; - keep_going = 1; - while (i < ia && keep_going) { - i = i+1; - if (value <= array[i]) { - index = i; - if (array[i]-value > value-array[i-1]) index = i-1; - keep_going = 0; - } - } - } - return index; - -} - -/******************************************************************/ - -void tokenize(const char * const string, const char *tokens, unsigned int varlen, - unsigned int maxvar, char * pstring, unsigned int * const nstr) -{ - size_t i, j, nvar, len, ntoken; - int found, n; - - nvar = 0; j = 0; - len = strlen(string); - ntoken = strlen(tokens); - /* here we use the fact that C array [][] is contiguous in memory */ - if(string[0] == 0)error_handler("Error from tokenize: to-be-parsed string is empty"); - - for(i = 0; i < len; i ++){ - if(string[i] != ' ' && string[i] != '\t'){ - found = 0; - for(n=0; n= maxvar) error_handler("Error from tokenize: number of variables exceeds limit"); - } - } - else { - *(pstring + nvar*varlen + j++) = string[i]; - if(j >= varlen ) error_handler("error from tokenize: variable name length exceeds limit during tokenization"); - } - } - } - *(pstring + nvar*varlen + j) = 0; - - *nstr = ++nvar; - -} - -/******************************************************************************* - double maxval_double(int size, double *data) - get the maximum value of double array -*******************************************************************************/ -double maxval_double(int size, const double *data) -{ - int n; - double maxval; - - maxval = data[0]; - for(n=1; n maxval ) maxval = data[n]; - } - - return maxval; - -} /* maxval_double */ - - -/******************************************************************************* - double minval_double(int size, double *data) - get the minimum value of double array -*******************************************************************************/ -double minval_double(int size, const double *data) -{ - int n; - double minval; - - minval = data[0]; - for(n=1; n M_PI) dx = dx - 2.0*M_PI; - if(dx < -M_PI) dx = dx + 2.0*M_PI; - - return (dx*(sin(ur_lat)-sin(ll_lat))*RADIUS*RADIUS ) ; - -} /* box_area */ - - -/*------------------------------------------------------------------------------ - double poly_area(const x[], const y[], int n) - obtains area of input polygon by line integrating -sin(lat)d(lon) - Vertex coordinates must be in degrees. - Vertices must be listed counter-clockwise around polygon. - grid is in radians. - ----------------------------------------------------------------------------*/ -double poly_area_dimensionless(const double x[], const double y[], int n) -{ - double area = 0.0; - int i; - - for (i=0;i M_PI) dx = dx - 2.0*M_PI; - if(dx < -M_PI) dx = dx + 2.0*M_PI; - if (dx==0.0) continue; - - if ( fabs(lat1-lat2) < SMALL_VALUE) /* cheap area calculation along latitude */ - area -= dx*sin(0.5*(lat1+lat2)); - else { - dy = 0.5*(lat1-lat2); - dat = sin(dy)/dy; - area -= dx*sin(0.5*(lat1+lat2))*dat; - } - } - if(area < 0) - return (-area/(4*M_PI)); - else - return (area/(4*M_PI)); - -} /* poly_area */ - -double poly_area(const double x[], const double y[], int n) -{ - double area = 0.0; - int i; - - for (i=0;i M_PI) dx = dx - 2.0*M_PI; - if(dx < -M_PI) dx = dx + 2.0*M_PI; - if (dx==0.0) continue; - - if ( fabs(lat1-lat2) < SMALL_VALUE) /* cheap area calculation along latitude */ - area -= dx*sin(0.5*(lat1+lat2)); - else { - dy = 0.5*(lat1-lat2); - dat = sin(dy)/dy; - area -= dx*sin(0.5*(lat1+lat2))*dat; - } - } - if(area < 0) - return -area*RADIUS*RADIUS; - else - return area*RADIUS*RADIUS; - -} /* poly_area */ - -double poly_area_no_adjust(const double x[], const double y[], int n) -{ - double area = 0.0; - int i; - - for (i=0;i=n_ins;i--) { - x[i+1] = x[i]; - y[i+1] = y[i]; - } - - x[n_ins] = lon_in; - y[n_ins] = lat_in; - return (n+1); -} /* insert_vtx */ - -void v_print(double x[], double y[], int n) -{ - int i; - - for (i=0;i=HPI-TOLORENCE) pole = 1; - if (0&&pole) { - printf("fixing pole cell\n"); - v_print(x, y, nn); - printf("---------"); - } - - /* all pole points must be paired */ - for (i=0;i=HPI-TOLORENCE) { - int im=(i+nn-1)%nn, ip=(i+1)%nn; - - if (y[im]==y[i] && y[ip]==y[i]) { - nn = delete_vtx(x, y, nn, i); - i--; - } else if (y[im]!=y[i] && y[ip]!=y[i]) { - nn = insert_vtx(x, y, nn, i, x[i], y[i]); - i++; - } - } - /* first of pole pair has longitude of previous vertex */ - /* second of pole pair has longitude of subsequent vertex */ - for (i=0;i=HPI-TOLORENCE) { - int im=(i+nn-1)%nn, ip=(i+1)%nn; - - if (y[im]!=y[i]){ - x[i] = x[im]; - } - if (y[ip]!=y[i]){ - x[i] = x[ip]; - } - } - - if (nn){ - x_sum = x[0]; - } - else{ - return(0); - } - for (i=1;i M_PI) dx_ = dx_ - TPI; - x_sum += (x[i] = x[i-1] + dx_); - } - - dx = (x_sum/nn)-tlon; - if (dx < -M_PI){ - for (i=0;i M_PI){ - for (i=0;i angle - \ - \ - p2 - -----------------------------------------------------------------------------*/ -double spherical_angle(const double *v1, const double *v2, const double *v3) -{ - double angle; - long double px, py, pz, qx, qy, qz, ddd; - - /* vector product between v1 and v2 */ - px = v1[1]*v2[2] - v1[2]*v2[1]; - py = v1[2]*v2[0] - v1[0]*v2[2]; - pz = v1[0]*v2[1] - v1[1]*v2[0]; - /* vector product between v1 and v3 */ - qx = v1[1]*v3[2] - v1[2]*v3[1]; - qy = v1[2]*v3[0] - v1[0]*v3[2]; - qz = v1[0]*v3[1] - v1[1]*v3[0]; - - ddd = (px*px+py*py+pz*pz)*(qx*qx+qy*qy+qz*qz); - if ( ddd <= 0.0 ) - angle = 0. ; - else { - ddd = (px*qx+py*qy+pz*qz) / sqrtl(ddd); - if( fabsl(ddd-1) < EPSLN30 ) ddd = 1; - if( fabsl(ddd+1) < EPSLN30 ) ddd = -1; - if ( ddd>1. || ddd<-1. ) { - /*FIX (lmh) to correctly handle co-linear points (angle near pi or 0) */ - if (ddd < 0.) - angle = M_PI; - else - angle = 0.; - } - else - angle = ((double)acosl( ddd )); - } - - return angle; -} /* spherical_angle */ - -/*------------------------------------------------------------------------------ - double spherical_excess_area(p_lL, p_uL, p_lR, p_uR) - get the surface area of a cell defined as a quadrilateral - on the sphere. Area is computed as the spherical excess - [area units are m^2] - ----------------------------------------------------------------------------*/ -double spherical_excess_area(const double* p_ll, const double* p_ul, - const double* p_lr, const double* p_ur, double radius) -{ - double area, ang1, ang2, ang3, ang4; - double v1[3], v2[3], v3[3]; - - /* S-W: 1 */ - latlon2xyz(1, p_ll, p_ll+1, v1, v1+1, v1+2); - latlon2xyz(1, p_lr, p_lr+1, v2, v2+1, v2+2); - latlon2xyz(1, p_ul, p_ul+1, v3, v3+1, v3+2); - ang1 = spherical_angle(v1, v2, v3); - - /* S-E: 2 */ - latlon2xyz(1, p_lr, p_lr+1, v1, v1+1, v1+2); - latlon2xyz(1, p_ur, p_ur+1, v2, v2+1, v2+2); - latlon2xyz(1, p_ll, p_ll+1, v3, v3+1, v3+2); - ang2 = spherical_angle(v1, v2, v3); - - /* N-E: 3 */ - latlon2xyz(1, p_ur, p_ur+1, v1, v1+1, v1+2); - latlon2xyz(1, p_ul, p_ul+1, v2, v2+1, v2+2); - latlon2xyz(1, p_lr, p_lr+1, v3, v3+1, v3+2); - ang3 = spherical_angle(v1, v2, v3); - - /* N-W: 4 */ - latlon2xyz(1, p_ul, p_ul+1, v1, v1+1, v1+2); - latlon2xyz(1, p_ur, p_ur+1, v2, v2+1, v2+2); - latlon2xyz(1, p_ll, p_ll+1, v3, v3+1, v3+2); - ang4 = spherical_angle(v1, v2, v3); - - area = (ang1 + ang2 + ang3 + ang4 - 2.*M_PI) * radius* radius; - - return area; - -} /* spherical_excess_area */ - - -/*---------------------------------------------------------------------- - void vect_cross(e, p1, p2) - Perform cross products of 3D vectors: e = P1 X P2 - -------------------------------------------------------------------*/ - -void vect_cross(const double *p1, const double *p2, double *e ) -{ - - e[0] = p1[1]*p2[2] - p1[2]*p2[1]; - e[1] = p1[2]*p2[0] - p1[0]*p2[2]; - e[2] = p1[0]*p2[1] - p1[1]*p2[0]; - -} /* vect_cross */ - - -/*---------------------------------------------------------------------- - double* vect_cross(p1, p2) - return cross products of 3D vectors: = P1 X P2 - -------------------------------------------------------------------*/ - -double dot(const double *p1, const double *p2) -{ - - return( p1[0]*p2[0] + p1[1]*p2[1] + p1[2]*p2[2] ); - -} - - -double metric(const double *p) { - return (sqrt(p[0]*p[0] + p[1]*p[1]+p[2]*p[2]) ); -} - - -/* ---------------------------------------------------------------- - make a unit vector - --------------------------------------------------------------*/ -void normalize_vect(double *e) -{ - double pdot; - int k; - - pdot = e[0]*e[0] + e[1] * e[1] + e[2] * e[2]; - pdot = sqrt( pdot ); - - for(k=0; k<3; k++) e[k] /= pdot; -} - - -/*------------------------------------------------------------------ - void unit_vect_latlon(int size, lon, lat, vlon, vlat) - - calculate unit vector for latlon in cartesian coordinates - - ---------------------------------------------------------------------*/ -void unit_vect_latlon(int size, const double *lon, const double *lat, double *vlon, double *vlat) -{ - double sin_lon, cos_lon, sin_lat, cos_lat; - int n; - - for(n=0; n MAXNODELIST) error_handler("getNext: curListPos >= MAXNODELIST"); - - return (temp); -} - - -void initNode(struct Node *node) -{ - node->x = 0; - node->y = 0; - node->z = 0; - node->u = 0; - node->intersect = 0; - node->inbound = 0; - node->isInside = 0; - node->Next = NULL; - node->initialized=0; - -} - -void addEnd(struct Node *list, double x, double y, double z, int intersect, double u, int inbound, int inside) -{ - - struct Node *temp=NULL; - - if(list == NULL) error_handler("addEnd: list is NULL"); - - if(list->initialized) { - - /* (x,y,z) might already in the list when intersect is true and u=0 or 1 */ - temp = list; - while (temp) { - if(samePoint(temp->x, temp->y, temp->z, x, y, z)) return; - temp=temp->Next; - } - temp = list; - while(temp->Next) - temp=temp->Next; - - /* Append at the end of the list. */ - temp->Next = getNext(); - temp = temp->Next; - } - else { - temp = list; - } - - temp->x = x; - temp->y = y; - temp->z = z; - temp->u = u; - temp->intersect = intersect; - temp->inbound = inbound; - temp->initialized=1; - temp->isInside = inside; -} - -/* return 1 if the point (x,y,z) is added in the list, return 0 if it is already in the list */ - -int addIntersect(struct Node *list, double x, double y, double z, int intersect, double u1, double u2, int inbound, - int is1, int ie1, int is2, int ie2) -{ - - double u1_cur, u2_cur; - int i1_cur, i2_cur; - struct Node *temp=NULL; - - if(list == NULL) error_handler("addEnd: list is NULL"); - - /* first check to make sure this point is not in the list */ - u1_cur = u1; - i1_cur = is1; - u2_cur = u2; - i2_cur = is2; - if(u1_cur == 1) { - u1_cur = 0; - i1_cur = ie1; - } - if(u2_cur == 1) { - u2_cur = 0; - i2_cur = ie2; - } - - if(list->initialized) { - temp = list; - while(temp) { - if( temp->u == u1_cur && temp->subj_index == i1_cur) return 0; - if( temp->u_clip == u2_cur && temp->clip_index == i2_cur) return 0; - if( !temp->Next ) break; - temp=temp->Next; - } - - /* Append at the end of the list. */ - temp->Next = getNext(); - temp = temp->Next; - } - else { - temp = list; - } - - temp->x = x; - temp->y = y; - temp->z = z; - temp->intersect = intersect; - temp->inbound = inbound; - temp->initialized=1; - temp->isInside = 0; - temp->u = u1_cur; - temp->subj_index = i1_cur; - temp->u_clip = u2_cur; - temp->clip_index = i2_cur; - - return 1; -} - - -int length(struct Node *list) -{ - struct Node *cur_ptr=NULL; - int count=0; - - cur_ptr=list; - - while(cur_ptr) - { - if(cur_ptr->initialized ==0) break; - cur_ptr=cur_ptr->Next; - count++; - } - return(count); -} - -/* two points are the same if there are close enough */ -int samePoint(double x1, double y1, double z1, double x2, double y2, double z2) -{ - if( fabs(x1-x2) > EPSLN10 || fabs(y1-y2) > EPSLN10 || fabs(z1-z2) > EPSLN10 ) - return 0; - else - return 1; -} - - - -int sameNode(struct Node node1, struct Node node2) -{ - if( node1.x == node2.x && node1.y == node2.y && node1.z==node2.z ) - return 1; - else - return 0; -} - - -void addNode(struct Node *list, struct Node inNode) -{ - - addEnd(list, inNode.x, inNode.y, inNode.z, inNode.intersect, inNode.u, inNode.inbound, inNode.isInside); - -} - -struct Node *getNode(struct Node *list, struct Node inNode) -{ - struct Node *thisNode=NULL; - struct Node *temp=NULL; - - temp = list; - while( temp ) { - if( sameNode( *temp, inNode ) ) { - thisNode = temp; - temp = NULL; - break; - } - temp = temp->Next; - } - - return thisNode; -} - -struct Node *getNextNode(struct Node *list) -{ - return list->Next; -} - -void copyNode(struct Node *node_out, struct Node node_in) -{ - - node_out->x = node_in.x; - node_out->y = node_in.y; - node_out->z = node_in.z; - node_out->u = node_in.u; - node_out->intersect = node_in.intersect; - node_out->inbound = node_in.inbound; - node_out->Next = NULL; - node_out->initialized = node_in.initialized; - node_out->isInside = node_in.isInside; -} - -void printNode(struct Node *list, char *str) -{ - struct Node *temp; - - if(list == NULL) error_handler("printNode: list is NULL"); - if(str) printf(" %s \n", str); - temp = list; - while(temp) { - if(temp->initialized ==0) break; - printf(" (x, y, z, interset, inbound, isInside) = (%19.15f,%19.15f,%19.15f,%d,%d,%d)\n", - temp->x, temp->y, temp->z, temp->intersect, temp->inbound, temp->isInside); - temp = temp->Next; - } - printf("\n"); -} - -int intersectInList(struct Node *list, double x, double y, double z) -{ - struct Node *temp; - int found=0; - - temp = list; - found = 0; - while ( temp ) { - if( temp->x == x && temp->y == y && temp->z == z ) { - found = 1; - break; - } - temp=temp->Next; - } - if (!found) error_handler("intersectInList: point (x,y,z) is not found in the list"); - if( temp->intersect == 2 ) - return 1; - else - return 0; - -} - - -/* The following insert a intersection after non-intersect point (x2,y2,z2), if the point - after (x2,y2,z2) is an intersection, if u is greater than the u value of the intersection, - insert after, otherwise insert before -*/ -void insertIntersect(struct Node *list, double x, double y, double z, double u1, double u2, int inbound, - double x2, double y2, double z2) -{ - struct Node *temp1=NULL, *temp2=NULL; - struct Node *temp; - double u_cur; - int found=0; - - temp1 = list; - found = 0; - while ( temp1 ) { - if( temp1->x == x2 && temp1->y == y2 && temp1->z == z2 ) { - found = 1; - break; - } - temp1=temp1->Next; - } - if (!found) error_handler("inserAfter: point (x,y,z) is not found in the list"); - - /* when u = 0 or u = 1, set the grid point to be the intersection point to solve truncation error isuse */ - u_cur = u1; - if(u1 == 1) { - u_cur = 0; - temp1 = temp1->Next; - if(!temp1) temp1 = list; - } - if(u_cur==0) { - temp1->intersect = 2; - temp1->isInside = 1; - temp1->u = u_cur; - temp1->x = x; - temp1->y = y; - temp1->z = z; - return; - } - - /* when u2 != 0 and u2 !=1, can decide if one end of the point is outside depending on inbound value */ - if(u2 != 0 && u2 != 1) { - if(inbound == 1) { /* goes outside, then temp1->Next is an outside point */ - /* find the next non-intersect point */ - temp2 = temp1->Next; - if(!temp2) temp2 = list; - while(temp2->intersect) { - temp2=temp2->Next; - if(!temp2) temp2 = list; - } - - temp2->isInside = 0; - } - else if(inbound ==2) { /* goes inside, then temp1 is an outside point */ - temp1->isInside = 0; - } - } - - temp2 = temp1->Next; - while ( temp2 ) { - if( temp2->intersect == 1 ) { - if( temp2->u > u_cur ) { - break; - } - } - else - break; - temp1 = temp2; - temp2 = temp2->Next; - } - - /* assign value */ - temp = getNext(); - temp->x = x; - temp->y = y; - temp->z = z; - temp->u = u_cur; - temp->intersect = 1; - temp->inbound = inbound; - temp->isInside = 1; - temp->initialized = 1; - temp1->Next = temp; - temp->Next = temp2; - -} - -double gridArea(struct Node *grid) { - double x[20], y[20], z[20]; - struct Node *temp=NULL; - double area; - int n; - - temp = grid; - n = 0; - while( temp ) { - x[n] = temp->x; - y[n] = temp->y; - z[n] = temp->z; - n++; - temp = temp->Next; - } - - area = great_circle_area(n, x, y, z); - - return area; - -} - -int isIntersect(struct Node node) { - - return node.intersect; - -} - - -int getInbound( struct Node node ) -{ - return node.inbound; -} - -struct Node *getLast(struct Node *list) -{ - struct Node *temp1; - - temp1 = list; - if( temp1 ) { - while( temp1->Next ) { - temp1 = temp1->Next; - } - } - - return temp1; -} - - -int getFirstInbound( struct Node *list, struct Node *nodeOut) -{ - struct Node *temp=NULL; - - temp=list; - - while(temp) { - if( temp->inbound == 2 ) { - copyNode(nodeOut, *temp); - return 1; - } - temp=temp->Next; - } - - return 0; -} - -void getCoordinate(struct Node node, double *x, double *y, double *z) -{ - - - *x = node.x; - *y = node.y; - *z = node.z; - -} - -void getCoordinates(struct Node *node, double *p) -{ - - - p[0] = node->x; - p[1] = node->y; - p[2] = node->z; - -} - -void setCoordinate(struct Node *node, double x, double y, double z) -{ - - - node->x = x; - node->y = y; - node->z = z; - -} - -/* set inbound value for the points in interList that has inbound =0, - this will also set some inbound value of the points in list1 -*/ - -void setInbound(struct Node *interList, struct Node *list) -{ - - struct Node *temp1=NULL, *temp=NULL; - struct Node *temp1_prev=NULL, *temp1_next=NULL; - int prev_is_inside, next_is_inside; - - /* for each point in interList, search through list to decide the inbound value the interList point */ - /* For each inbound point, the prev node should be outside and the next is inside. */ - if(length(interList) == 0) return; - - temp = interList; - - while(temp) { - if( !temp->inbound) { - /* search in grid1 to find the prev and next point of temp, when prev point is outside and next point is inside - inbound = 2, else inbound = 1*/ - temp1 = list; - temp1_prev = NULL; - temp1_next = NULL; - while(temp1) { - if(sameNode(*temp1, *temp)) { - if(!temp1_prev) temp1_prev = getLast(list); - temp1_next = temp1->Next; - if(!temp1_next) temp1_next = list; - break; - } - temp1_prev = temp1; - temp1 = temp1->Next; - } - if(!temp1_next) error_handler("Error from create_xgrid.c: temp is not in list1"); - if( temp1_prev->isInside == 0 && temp1_next->isInside == 1) - temp->inbound = 2; /* go inside */ - else - temp->inbound = 1; - } - temp=temp->Next; - } -} - -int isInside(struct Node *node) { - - if(node->isInside == -1) error_handler("Error from mosaic_util.c: node->isInside is not set"); - return(node->isInside); - -} - -/* #define debug_test_create_xgrid */ - -/* check if node is inside polygon list or not */ -int insidePolygon( struct Node *node, struct Node *list) -{ - int is_inside; - double pnt0[3], pnt1[3], pnt2[3]; - double anglesum; - struct Node *p1=NULL, *p2=NULL; - - anglesum = 0; - - pnt0[0] = node->x; - pnt0[1] = node->y; - pnt0[2] = node->z; - - p1 = list; - p2 = list->Next; - is_inside = 0; - - - while(p1) { - pnt1[0] = p1->x; - pnt1[1] = p1->y; - pnt1[2] = p1->z; - pnt2[0] = p2->x; - pnt2[1] = p2->y; - pnt2[2] = p2->z; - if( samePoint(pnt0[0], pnt0[1], pnt0[2], pnt1[0], pnt1[1], pnt1[2]) ){ - return 1; - } - anglesum += spherical_angle(pnt0, pnt2, pnt1); - p1 = p1->Next; - p2 = p2->Next; - if(p2==NULL){ - p2 = list; - } - } - - if( fabs(anglesum - 2*M_PI) < EPSLN8 ){ - is_inside = 1; - } - else{ - is_inside = 0; - } - -#ifdef debug_test_create_xgrid - printf("anglesum-2PI is %19.15f, is_inside = %d\n", anglesum- 2*M_PI, is_inside); -#endif - - return is_inside; - -} - -int inside_a_polygon(double *lon1, double *lat1, int *npts, double *lon2, double *lat2) -{ - - double x2[20], y2[20], z2[20]; - double x1, y1, z1; - double min_x2, max_x2, min_y2, max_y2, min_z2, max_z2; - int isinside, i; - - struct Node *grid1=NULL, *grid2=NULL; - - /* first convert to cartesian grid */ - latlon2xyz(*npts, lon2, lat2, x2, y2, z2); - latlon2xyz(1, lon1, lat1, &x1, &y1, &z1); - - max_x2 = maxval_double(*npts, x2); - if(x1 >= max_x2+RANGE_CHECK_CRITERIA) return 0; - min_x2 = minval_double(*npts, x2); - if(min_x2 >= x1+RANGE_CHECK_CRITERIA) return 0; - - max_y2 = maxval_double(*npts, y2); - if(y1 >= max_y2+RANGE_CHECK_CRITERIA) return 0; - min_y2 = minval_double(*npts, y2); - if(min_y2 >= y1+RANGE_CHECK_CRITERIA) return 0; - - max_z2 = maxval_double(*npts, z2); - if(z1 >= max_z2+RANGE_CHECK_CRITERIA) return 0; - min_z2 = minval_double(*npts, z2); - if(min_z2 >= z1+RANGE_CHECK_CRITERIA) return 0; - - - /* add x2,y2,z2 to a Node */ - rewindList(); - grid1 = getNext(); - grid2 = getNext(); - - addEnd(grid1, x1, y1, z1, 0, 0, 0, -1); - for(i=0; i<*npts; i++) addEnd(grid2, x2[i], y2[i], z2[i], 0, 0, 0, -1); - - isinside = insidePolygon(grid1, grid2); - - return isinside; - -} - -int inside_a_polygon_(double *lon1, double *lat1, int *npts, double *lon2, double *lat2) -{ - - int isinside; - - isinside = inside_a_polygon(lon1, lat1, npts, lon2, lat2); - - return isinside; - -} diff --git a/mosaic/read_mosaic.c b/mosaic/read_mosaic.c deleted file mode 100644 index 9fafad1f2b..0000000000 --- a/mosaic/read_mosaic.c +++ /dev/null @@ -1,779 +0,0 @@ -/*********************************************************************** - * GNU Lesser General Public License - * - * This file is part of the GFDL Flexible Modeling System (FMS). - * - * FMS 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. - * - * FMS 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 Lesser General Public - * License along with FMS. If not, see . - **********************************************************************/ -#include -#include -#include -#include -#include "read_mosaic.h" -#include "constant.h" -#include "mosaic_util.h" -#include - -/** \file - * \ingroup mosaic - * \brief Support for reading mosaic netcdf grid files. - */ - -/********************************************************************* - void netcdf_error( int status ) - status is the returning value of netcdf call. this routine will - handle the error when status is not NC_NOERR. -********************************************************************/ -void handle_netcdf_error(const char *msg, int status ) -{ - char errmsg[512]; - - sprintf( errmsg, "%s: %s", msg, (char *)nc_strerror(status) ); - error_handler(errmsg); - -} /* handle_netcdf_error */ - -/*************************************************************************** - void get_file_dir(const char *file, char *dir) - get the directory where file is located. The dir will be the complate path - before the last "/". If no "/" exist in file, the path will be current ".". -***************************************************************************/ -void get_file_dir(const char *file, char *dir) -{ - int len; - const char *strptr = NULL; - - /* get the diretory */ - - strptr = strrchr(file, '/'); - if(strptr) { - len = strptr - file; - strncpy(dir, file, len); - } - else { - len = 1; - strcpy(dir, "."); - } - dir[len] = 0; - -} /* get_file_dir */ - - -int field_exist(const char* file, const char *name) -{ - int ncid, varid, status; - char msg[512]; - int existed=0; - -#ifdef use_netCDF - - status = nc_open(file, NC_NOWRITE, &ncid); - if(status != NC_NOERR) { - sprintf(msg, "field_exist: in opening file %s", file); - handle_netcdf_error(msg, status); - } - - status = nc_inq_varid(ncid, name, &varid); - if(status == NC_NOERR){ - existed = 1; - } - - status = nc_close(ncid); - if(status != NC_NOERR) { - sprintf(msg, "field_exist: in closing file %s.", file); - handle_netcdf_error(msg, status); - } - -#else /* ndef use_netCDF */ - error_handler("read_mosaic: Add flag -Duse_netCDF when compiling"); -#endif /* use_netcdf */ - - return existed; - -} /* field_exist */ - -int get_dimlen(const char* file, const char *name) -{ - int ncid, dimid, status, len; - size_t size; - char msg[512]; - - len = 0; -#ifdef use_netCDF - status = nc_open(file, NC_NOWRITE, &ncid); - if(status != NC_NOERR) { - sprintf(msg, "in opening file %s", file); - handle_netcdf_error(msg, status); - } - - status = nc_inq_dimid(ncid, name, &dimid); - if(status != NC_NOERR) { - sprintf(msg, "in getting dimid of %s from file %s.", name, file); - handle_netcdf_error(msg, status); - } - - status = nc_inq_dimlen(ncid, dimid, &size); - if(status != NC_NOERR) { - sprintf(msg, "in getting dimension size of %s from file %s.", name, file); - handle_netcdf_error(msg, status); - } - status = nc_close(ncid); - if(status != NC_NOERR) { - sprintf(msg, "in closing file %s.", file); - handle_netcdf_error(msg, status); - } - - len = size; - if(status != NC_NOERR) { - sprintf(msg, "in closing file %s", file); - handle_netcdf_error(msg, status); - } -#else - error_handler("read_mosaic: Add flag -Duse_netCDF when compiling"); -#endif - - return len; - -} /* get_dimlen */ - -/******************************************************************************* - void get_string_data(const char *file, const char *name, char *data) - get string data of field with "name" from "file". -******************************************************************************/ -void get_string_data(const char *file, const char *name, char *data) -{ - int ncid, varid, status; - char msg[512]; - -#ifdef use_netCDF - status = nc_open(file, NC_NOWRITE, &ncid); - if(status != NC_NOERR) { - sprintf(msg, "in opening file %s", file); - handle_netcdf_error(msg, status); - } - status = nc_inq_varid(ncid, name, &varid); - if(status != NC_NOERR) { - sprintf(msg, "in getting varid of %s from file %s.", name, file); - handle_netcdf_error(msg, status); - } - status = nc_get_var_text(ncid, varid, data); - if(status != NC_NOERR) { - sprintf(msg, "in getting data of %s from file %s.", name, file); - handle_netcdf_error(msg, status); - } - status = nc_close(ncid); - if(status != NC_NOERR) { - sprintf(msg, "in closing file %s.", file); - handle_netcdf_error(msg, status); - } -#else - error_handler("read_mosaic: Add flag -Duse_netCDF when compiling"); -#endif - -} /* get_string_data */ - -/******************************************************************************* - void get_string_data_level(const char *file, const char *name, const size_t *start, const size_t *nread, char *data) - get string data of field with "name" from "file". -******************************************************************************/ -void get_string_data_level(const char *file, const char *name, char *data, const unsigned int *level) -{ - int ncid, varid, status, i; - size_t start[4], nread[4]; - char msg[512]; - -#ifdef use_netCDF - status = nc_open(file, NC_NOWRITE, &ncid); - if(status != NC_NOERR) { - sprintf(msg, "in opening file %s", file); - handle_netcdf_error(msg, status); - } - status = nc_inq_varid(ncid, name, &varid); - if(status != NC_NOERR) { - sprintf(msg, "in getting varid of %s from file %s.", name, file); - handle_netcdf_error(msg, status); - } - for(i=0; i<4; i++) { - start[i] = 0; nread[i] = 1; - } - start[0] = *level; nread[1] = STRING; - status = nc_get_vara_text(ncid, varid, start, nread, data); - if(status != NC_NOERR) { - sprintf(msg, "in getting data of %s from file %s.", name, file); - handle_netcdf_error(msg, status); - } - status = nc_close(ncid); - if(status != NC_NOERR) { - sprintf(msg, "in closing file %s.", file); - handle_netcdf_error(msg, status); - } -#else - error_handler("read_mosaic: Add flag -Duse_netCDF when compiling"); -#endif - -} /* get_string_data_level */ - - -/******************************************************************************* - void get_var_data(const char *file, const char *name, double *data) - get var data of field with "name" from "file". -******************************************************************************/ -void get_var_data(const char *file, const char *name, void *data) -{ - - int ncid, varid, status; - nc_type vartype; - char msg[512]; - -#ifdef use_netCDF - status = nc_open(file, NC_NOWRITE, &ncid); - if(status != NC_NOERR) { - sprintf(msg, "in opening file %s", file); - handle_netcdf_error(msg, status); - } - status = nc_inq_varid(ncid, name, &varid); - if(status != NC_NOERR) { - sprintf(msg, "in getting varid of %s from file %s.", name, file); - handle_netcdf_error(msg, status); - } - - status = nc_inq_vartype(ncid, varid, &vartype); - if(status != NC_NOERR) { - sprintf(msg, "get_var_data: in getting vartype of of %s in file %s ", name, file); - handle_netcdf_error(msg, status); - } - - switch (vartype) { - case NC_DOUBLE:case NC_FLOAT: - status = nc_get_var_double(ncid, varid, (double *)data); - break; - case NC_INT: - status = nc_get_var_int(ncid, varid, (int *)data); - break; - default: - sprintf(msg, "get_var_data: field %s in file %s has an invalid type, " - "the type should be NC_DOUBLE, NC_FLOAT or NC_INT", name, file); - error_handler(msg); - } - if(status != NC_NOERR) { - sprintf(msg, "in getting data of %s from file %s.", name, file); - handle_netcdf_error(msg, status); - } - status = nc_close(ncid); - if(status != NC_NOERR) { - sprintf(msg, "in closing file %s.", file); - handle_netcdf_error(msg, status); - } -#else - error_handler("read_mosaic: Add flag -Duse_netCDF when compiling"); -#endif - -} /* get_var_data */ - -/******************************************************************************* - void get_var_data(const char *file, const char *name, double *data) - get var data of field with "name" from "file". -******************************************************************************/ -void get_var_data_region(const char *file, const char *name, const size_t *start, const size_t *nread, void *data) -{ - - int ncid, varid, status; - nc_type vartype; - char msg[512]; - -#ifdef use_netCDF - status = nc_open(file, NC_NOWRITE, &ncid); - if(status != NC_NOERR) { - sprintf(msg, "get_var_data_region: in opening file %s", file); - handle_netcdf_error(msg, status); - } - status = nc_inq_varid(ncid, name, &varid); - if(status != NC_NOERR) { - sprintf(msg, "in getting varid of %s from file %s.", name, file); - handle_netcdf_error(msg, status); - } - - status = nc_inq_vartype(ncid, varid, &vartype); - if(status != NC_NOERR) { - sprintf(msg, "get_var_data_region: in getting vartype of of %s in file %s ", name, file); - handle_netcdf_error(msg, status); - } - - switch (vartype) { - case NC_DOUBLE:case NC_FLOAT: - status = nc_get_vara_double(ncid, varid, start, nread, (double *)data); - break; - case NC_INT: - status = nc_get_vara_int(ncid, varid, start, nread, (int *)data); - break; - default: - sprintf(msg, "get_var_data_region: field %s in file %s has an invalid type, " - "the type should be NC_DOUBLE, NC_FLOAT or NC_INT", name, file); - error_handler(msg); - } - - if(status != NC_NOERR) { - sprintf(msg, "get_var_data_region: in getting data of %s from file %s.", name, file); - handle_netcdf_error(msg, status); - } - status = nc_close(ncid); - if(status != NC_NOERR) { - sprintf(msg, "get_var_data_region: in closing file %s.", file); - handle_netcdf_error(msg, status); - } -#else - error_handler("read_mosaic: Add flag -Duse_netCDF when compiling"); -#endif - -} /* get_var_data_region */ - -/****************************************************************************** - void get_var_text_att(const char *file, const char *name, const char *attname, char *att) - get text attribute of field 'name' from 'file -******************************************************************************/ -void get_var_text_att(const char *file, const char *name, const char *attname, char *att) -{ - int ncid, varid, status; - char msg[512]; - -#ifdef use_netCDF - status = nc_open(file, NC_NOWRITE, &ncid); - if(status != NC_NOERR) { - sprintf(msg, "in opening file %s", file); - handle_netcdf_error(msg, status); - } - status = nc_inq_varid(ncid, name, &varid); - if(status != NC_NOERR) { - sprintf(msg, "in getting varid of %s from file %s.", name, file); - handle_netcdf_error(msg, status); - } - status = nc_get_att_text(ncid, varid, attname, att); - if(status != NC_NOERR) { - sprintf(msg, "in getting attribute %s of %s from file %s.", attname, name, file); - handle_netcdf_error(msg, status); - } - status = nc_close(ncid); - if(status != NC_NOERR) { - sprintf(msg, "in closing file %s.", file); - handle_netcdf_error(msg, status); - } -#else - error_handler("read_mosaic: Add flag -Duse_netCDF when compiling"); -#endif - -} /* get_var_text_att */ - -/*********************************************************************** - return number of overlapping cells. -***********************************************************************/ -int read_mosaic_xgrid_size_( const char *xgrid_file ) -{ - return read_mosaic_xgrid_size(xgrid_file); -} - -int read_mosaic_xgrid_size( const char *xgrid_file ) -{ - int ncells; - - ncells = get_dimlen(xgrid_file, "ncells"); - return ncells; -} - - double get_global_area(void) - { - double garea; - garea = 4*M_PI*RADIUS*RADIUS; - - return garea; - } - - double get_global_area_(void) - { - double garea; - garea = 4*M_PI*RADIUS*RADIUS; - - return garea; - } - - - /****************************************************************************/ - void read_mosaic_xgrid_order1_(const char *xgrid_file, int *i1, int *j1, int *i2, int *j2, double *area ) - { - read_mosaic_xgrid_order1(xgrid_file, i1, j1, i2, j2, area); - - } - - void read_mosaic_xgrid_order1(const char *xgrid_file, int *i1, int *j1, int *i2, int *j2, double *area ) - { - int ncells, n; - int *tile1_cell, *tile2_cell; - double garea; - - ncells = get_dimlen(xgrid_file, "ncells"); - - tile1_cell = (int *)malloc(ncells*2*sizeof(int)); - tile2_cell = (int *)malloc(ncells*2*sizeof(int)); - get_var_data(xgrid_file, "tile1_cell", tile1_cell); - get_var_data(xgrid_file, "tile2_cell", tile2_cell); - - get_var_data(xgrid_file, "xgrid_area", area); - - garea = 4*M_PI*RADIUS*RADIUS; - - for(n=0; n istart_in ) { - istart_out[0] = istart_in - 1; - iend_out[0] = iend_in - refine_ratio; - } - else { - istart_out[0] = istart_in - refine_ratio; - iend_out[0] = iend_in - 1; - } - - if( istart_out[0]%refine_ratio || iend_out[0]%refine_ratio) - error_handler("Error from read_mosaic: mismatch between refine_ratio and istart_in/iend_in"); - istart_out[0] /= refine_ratio; - iend_out[0] /= refine_ratio; - } - - return type; - - } - - - void read_mosaic_contact(const char *mosaic_file, int *tile1, int *tile2, int *istart1, int *iend1, - int *jstart1, int *jend1, int *istart2, int *iend2, int *jstart2, int *jend2) - { - char contacts[STRING]; - char **gridtiles; -#define MAXVAR 40 - char pstring[MAXVAR][STRING]; - unsigned int nstr, ntiles, ncontacts, n, m, l, found; - const int x_refine = 2, y_refine = 2; - int i1_type, j1_type, i2_type, j2_type; - - ntiles = get_dimlen(mosaic_file, "ntiles"); - gridtiles = (char **)malloc(ntiles*sizeof(char *)); - for(n=0; n '9' || pstring[m][l] < '0' ) { - error_handler("Error from read_mosaic: some of the character in " - "contact_indices except token is not digit number"); - } - } - } - istart1[n] = atoi(pstring[0]); - iend1[n] = atoi(pstring[1]); - jstart1[n] = atoi(pstring[2]); - jend1[n] = atoi(pstring[3]); - istart2[n] = atoi(pstring[4]); - iend2[n] = atoi(pstring[5]); - jstart2[n] = atoi(pstring[6]); - jend2[n] = atoi(pstring[7]); - i1_type = transfer_to_model_index(istart1[n], iend1[n], istart1+n, iend1+n, x_refine); - j1_type = transfer_to_model_index(jstart1[n], jend1[n], jstart1+n, jend1+n, y_refine); - i2_type = transfer_to_model_index(istart2[n], iend2[n], istart2+n, iend2+n, x_refine); - j2_type = transfer_to_model_index(jstart2[n], jend2[n], jstart2+n, jend2+n, y_refine); - if( i1_type == 0 && j1_type == 0 ) - error_handler("Error from read_mosaic_contact:istart1==iend1 and jstart1==jend1"); - if( i2_type == 0 && j2_type == 0 ) - error_handler("Error from read_mosaic_contact:istart2==iend2 and jstart2==jend2"); - if( i1_type + j1_type != i2_type + j2_type ) - error_handler("Error from read_mosaic_contact: It is not a line or overlap contact"); - - } - - for(m=0; m. - **********************************************************************/ -#ifndef READ_MOSAIC_H_ -#define READ_MOSAIC_H_ - -/* netcdf helpers */ -/* perhaps should consider making static, or breaking out into seperate file, - some of these names (field_exist) could pollute namespace... */ - -void handle_netcdf_error(const char *msg, int status ); - -void get_file_dir(const char *file, char *dir); - -int field_exist(const char* file, const char *name); - -int get_dimlen(const char* file, const char *name); - -void get_string_data_level(const char *file, const char *name, char *data, const unsigned int* level); - -void get_var_data(const char *file, const char *name, void *data); - -void get_var_data_region(const char *file, const char *name, const size_t *start, const size_t *nread, void *data); - -void get_string_data(const char *file, const char *name, char *data); - -void get_var_text_att(const char *file, const char *name, const char *attname, char *att); -/* end netcdf helpers */ - -int read_mosaic_xgrid_size( const char *xgrid_file ); - -void read_mosaic_xgrid_order1(const char *xgrid_file, int *i1, int *j1, int *i2, int *j2, double *area ); - -void read_mosaic_xgrid_order1_region(const char *xgrid_file, int *i1, int *j1, int *i2, int *j2, double *area, int *isc, int *iec ); - -void read_mosaic_xgrid_order2(const char *xgrid_file, int *i1, int *j1, int *i2, int *j2, - double *area, double *di, double *dj ); - -double get_global_area(void); - - -int read_mosaic_ntiles(const char *mosaic_file); - -int read_mosaic_ncontacts(const char *mosaic_file); - -void read_mosaic_grid_sizes(const char *mosaic_file, int *nx, int *ny); - -void read_mosaic_contact(const char *mosaic_file, int *tile1, int *tile2, int *istart1, int *iend1, - int *jstart1, int *jend1, int *istart2, int *iend2, int *jstart2, int *jend2); - -int transfer_to_model_index(int istart_in, int iend_in, int *istart_out, int *iend_out, int refine_ratio); - -void read_mosaic_grid_data(const char *mosaic_file, const char *name, int nx, int ny, - double *data, unsigned int level, int ioff, int joff); - - -void read_mosaic_contact_(const char *mosaic_file, int *tile1, int *tile2, int *istart1, int *iend1, - int *jstart1, int *jend1, int *istart2, int *iend2, int *jstart2, int *jend2); - -int read_mosaic_xgrid_size_( const char *xgrid_file ); - -int read_mosaic_ntiles_(const char *mosaic_file); - -int read_mosaic_ncontacts_(const char *mosaic_file); - -void read_mosaic_grid_sizes_(const char *mosaic_file, int *nx, int *ny); - - -double get_global_area_(void); - -void read_mosaic_xgrid_order1_(const char *xgrid_file, int *i1, int *j1, int *i2, int *j2, double *area ); - -void read_mosaic_xgrid_order1_region_(const char *xgrid_file, int *i1, int *j1, int *i2, int *j2, double *area, int *isc, int *iec ); - -void read_mosaic_xgrid_order2_(const char *xgrid_file, int *i1, int *j1, int *i2, int *j2, double *area, double *di, double *dj ); - -#endif diff --git a/test_fms/horiz_interp/Makefile.am b/test_fms/horiz_interp/Makefile.am index 812ab6cccb..27de50a932 100644 --- a/test_fms/horiz_interp/Makefile.am +++ b/test_fms/horiz_interp/Makefile.am @@ -29,14 +29,16 @@ AM_CPPFLAGS = -I$(MODDIR) LDADD = $(top_builddir)/libFMS/libFMS.la # Build these test programs. -check_PROGRAMS = test_horiz_interp_r4 test_horiz_interp_r8 +check_PROGRAMS = test_horiz_interp_r4 test_horiz_interp_r8 test_create_xgrid_order2_r8 # These are the sources for the tests. test_horiz_interp_r4_SOURCES = test_horiz_interp.F90 test_horiz_interp_r8_SOURCES = test_horiz_interp.F90 +test_create_xgrid_order2_r8_SOURCES = test_create_xgrid_order2.F90 test_horiz_interp_r4_CPPFLAGS=-DHI_TEST_KIND=4 -I$(MODDIR) test_horiz_interp_r8_CPPFLAGS=-DHI_TEST_KIND=8 -I$(MODDIR) +test_create_xgrid_order2_r8_CPPFLAGS=-DHI_TEST_KIND_=8 -I$(MODDIR) TEST_EXTENSIONS = .sh SH_LOG_DRIVER = env AM_TAP_AWK='$(AWK)' $(SHELL) \ @@ -44,10 +46,10 @@ SH_LOG_DRIVER = env AM_TAP_AWK='$(AWK)' $(SHELL) \ TESTS_ENVIRONMENT= test_input_path="@TEST_INPUT_PATH@" # Run the test programs. -TESTS = test_horiz_interp2.sh +TESTS = test_horiz_interp2.sh test_create_xgrid_order2.sh # These files will also be included in the distribution. -EXTRA_DIST = test_horiz_interp2.sh +EXTRA_DIST = test_horiz_interp2.sh test_create_xgrid_order2.sh # Clean up CLEANFILES = input.nml *.out* *.dpi *.spi *.dyn *.spl diff --git a/test_fms/horiz_interp/test_create_xgrid_order2.F90 b/test_fms/horiz_interp/test_create_xgrid_order2.F90 new file mode 100644 index 0000000000..5a3252c303 --- /dev/null +++ b/test_fms/horiz_interp/test_create_xgrid_order2.F90 @@ -0,0 +1,118 @@ +!*********************************************************************** +! GNU Lesser General Public License +! +! This file is part of the GFDL Flexible Modeling System (FMS). +! +! FMS 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. +! +! FMS 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 Lesser General Public +! License along with FMS. If not, see . +!**********************************************************************/ +!> This program ensures all necessary functions exist in grid_utils for +!! creating the exchange grid for second order remapping. +!! The first order exchange grid creation is tested in test_horiz_interp. +!! This test is rudimentary and only checks that create_xgrid_order2 returns +!! without failure. + +program test_create_xgrid_order2 + + use horiz_interp_mod + use constants_mod, only: DEG_TO_RAD + implicit none + + integer, parameter :: lkind = HI_TEST_KIND_ + + integer, parameter :: nlon_in = 10 !< number of input grid cells in lon direction + integer, parameter :: nlat_in = 10 !< number of input grid cells in the lat direction + integer, parameter :: nlon_out = nlon_in * 2 !< number of output grid cells in lon direction + integer, parameter :: nlat_out = nlat_in * 2 !< number of output grid cells in lat direction + integer, parameter :: ngridpts_in = (nlon_in+1)*(nlat_in+1) !< number of input gridpoints + integer, parameter :: ngridpts_out = (nlon_out+1)*(nlat_out+1) !< number of output gridpoints + integer, parameter :: nxgrid = nlon_out *nlat_out !< expected number of exchange grid cells + + real(HI_TEST_KIND_) :: lon_in(ngridpts_in) !< longitudinal values of input grid cell vertices + real(HI_TEST_KIND_) :: lat_in(ngridpts_in) !< latitudinal values of input grid cell vertices + real(HI_TEST_KIND_) :: lon_out(ngridpts_out) !< longitudinal values of output grid cell vertices + real(HI_TEST_KIND_) :: lat_out(ngridpts_out) !< latitudinal values of output grid cell vertices + real(HI_TEST_KIND_) :: mask(nlon_in*nlat_in) !< mask to skip input grid cell + + integer :: i_in(nxgrid) !< input parent cell indices + integer :: j_in(nxgrid) !< input parent cell indices + integer :: i_out(nxgrid) !< output parent cell indices + integer :: j_out(nxgrid) !< output parent cell indices + real(HI_TEST_KIND_) :: xgrid_area(nxgrid) !< exchange grid cell areas + real(HI_TEST_KIND_) :: xgrid_clon(nxgrid) !< longitudinal values of exchange grid cell centroid point + real(HI_TEST_KIND_) :: xgrid_clat(nxgrid) !< latitudinal values of exchange grid cell centroid point + + mask = 1.0_lkind + + call get_grid(nlon_in, nlat_in, lon_in, lat_in) + call get_grid(nlon_out, nlat_out, lon_out, lat_out) + + call test_create_xgrid_2dx2d_order2(nlon_in, nlat_in, nlon_out, nlat_out, nxgrid, & + mask, lon_in, lat_in, lon_out, lat_out, & + i_in, j_in, i_out, j_out, xgrid_area, xgrid_clon, xgrid_clat) + +contains + + !> Returns lon and lat arrays holding grid point values + subroutine get_grid(nlon, nlat, lon, lat) + + implicit none + integer, intent(in) :: nlon, nlat !< number of cell in lon and lat direction + real(HI_TEST_KIND_), intent(out) :: lon(:), lat(:) !< lon and lat values at cell vertices + + integer :: ilon, ilat, igridpt + real :: dlat=0.0_lkind, dlon=0.0_lkind + real :: lon_start=0.0_lkind, lat_start=-90.0_lkind*DEG_TO_RAD + + dlat = 180._lkind/real(nlat, HI_TEST_KIND_) * DEG_TO_RAD + dlon = 360._lkind/real(nlon, HI_TEST_KIND_) * DEG_TO_RAD + + igridpt = 1 + do ilat=1, nlat+1 + do ilon=1, nlon+1 + lon(igridpt) = lon_start + real(ilon-1, HI_TEST_KIND_)*dlon + lat(igridpt) = lat_start + real(ilat-1, HI_TEST_KIND_)*dlat + igridpt = igridpt + 1 + end do + end do + + end subroutine get_grid + + + !> Calls create_xgrid_2dx2d_order2. This subroutine also checks the returned value of nxgrid + subroutine test_create_xgrid_2dx2d_order2(nlon_inl, nlat_inl, nlon_outl, nlat_outl, nxgridl, & + maskl, lon_inl, lat_inl, lon_outl, lat_outl, & + i_inl, j_inl, i_outl, j_outl, xgrid_areal, xgrid_clonl, xgrid_clatl) + + implicit none + integer, intent(in) :: nlon_inl, nlat_inl, nlon_outl, nlat_outl, nxgridl !< number of grid cells + integer, intent(inout) :: i_inl(:), j_inl(:), i_outl(:), j_outl(:) !< parent cell indices + real(HI_TEST_KIND_), intent(in) :: lon_inl(:), lat_inl(:), lon_outl(:), lat_outl(:) !< lon and lat + real(HI_TEST_KIND_), intent(in) :: maskl(:) !< input grid cell mask + real(HI_TEST_KIND_), intent(out) :: xgrid_areal(:), xgrid_clonl(:), xgrid_clatl(:) !< returned xgrid info + + integer :: create_xgrid_2dx2d_order2 + integer :: nxgrid_out + + nxgrid_out = create_xgrid_2dx2d_order2(nlon_inl, nlat_inl, nlon_outl, nlat_outl, lon_inl, lat_inl, & + lon_outl, lat_outl, maskl, i_inl, j_inl, i_outl, j_outl, xgrid_areal, & + xgrid_clonl, xgrid_clatl) + + if(nxgrid_out /= nxgridl) then + write(*,*) 'Expected', nxgrid, 'but got', nxgrid_out + error stop + end if + + end subroutine test_create_xgrid_2dx2d_order2 + +end program test_create_xgrid_order2 diff --git a/test_fms/horiz_interp/test_create_xgrid_order2.sh b/test_fms/horiz_interp/test_create_xgrid_order2.sh new file mode 100755 index 0000000000..6076ee3eba --- /dev/null +++ b/test_fms/horiz_interp/test_create_xgrid_order2.sh @@ -0,0 +1,33 @@ +#!/bin/sh + +#*********************************************************************** +#* GNU Lesser General Public License +#* +#* This file is part of the GFDL Flexible Modeling System (FMS). +#* +#* FMS 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. +#* +#* FMS 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 Lesser General Public +#* License along with FMS. If not, see . +#*********************************************************************** + +# This is part of the GFDL FMS package. This is a shell script to +# execute tests in the test_fms/horiz_interp directory. + +# Ed Hartnett 11/29/19 +# Ryan Mulhall 01/23 + +# Set common test settings. +. ../test-lib.sh + + +test_expect_success "create_xgrid order2" 'mpirun -n 1 ./test_create_xgrid_order2_r8' +test_done