Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/README
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/README	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/README	(revision 2352)
@@ -0,0 +1,306 @@
+nocsSCRIP v1.1 03/11/2010
+-------------------------
+
+Author: NOCS NEMO Team
+Contacts: Steven Alderson (sga@noc.soton.ac.uk)
+          Andrew Coward   (acc@noc.soton.ac.uk)
+
+Disclaimer
+
+This directory contains software for generating and manipulating interpolation
+weights for use with the Interpolation On the Fly (IOF) option in NEMO
+v3 onwards.  The utilities rely heavily on the Spherical Coordinate Remapping
+and Interpolation Package (SCRIP) which is freely available from Los Alamos
+(see copyright file). We make no claim to authorship of those parts of the
+SCRIP package we have used and included with this distribution.
+
+Unless otherwise indicated, all other software has been authored by an
+employee or employees of the National Oceanography Centre, Southampton, UK
+(NOCS).  NOCS operates as a collaboration between the Natural Environment
+Research Council (NERC) and the University of Southampton.  The public may
+copy and use this software without charge, provided that this Notice and any
+statement of authorship are reproduced on all copies.  Neither NERC nor the
+University makes any warranty, express or implied, or assumes any liability
+or responsibility for the use of this software.
+
+Introduction
+
+The IOF option enables forced ocean runs without the need to provide surface
+boundary data on the nemo grid. Atmospheric data are kept on their original
+grid(s) which typically have a coarser resolution than the ocean grid. IOF
+supports multiple source (atmospheric) grids and two interpolation methods
+(bilinear and bicubic).  Different combinations of source grid and method can
+be selected for each variable.  IOF is also compatible with AGRIF; allowing
+AGRIF nests to be used without the need to provide separate forcing data
+(only a separate set of weights fields).  Operational details are provided
+in the SBC chapter of the NEMO reference manual.
+
+Please note that the methods described here assume that the forcing datasets
+are unmasked. Where the original sources are masked it is the users'
+responsibility to ensure that an unmasked set is produced on the source
+grid with appropriate oceanic values in previously masked locations. This
+is particularly important for atmospheric variables which experience step
+changes at the land-sea boundary. For these, care must be taken to avoid
+contaminating oceanic values.
+
+The software is divided into several sub-directories:
+
+                         ./
+                          |
+     +-------------+--------------+
+  SCRIP1.4      nocsutil         bin
+
+SCRIP1.4 contains the unmodified copy (apart from compression of two sample netcdf
+files) of SCRIP version 1.4 from Los Alamos. 
+(http://climate.lanl.gov/Software/SCRIP).
+
+The bin directory contains python script freeform.py.
+This is run to reformat the code for use within the NEMO 3.3 FCm framework.
+It creates and populates a directory called 'src' with copied and modified versions
+of the SCRIP library routines.  Changes are described in the src/CHANGES file.
+This script has already been run and only needs to be re-executed if SCRIP is updated.
+
+The nocscrip directory contains the code for the three programs used to 
+generate a weights file. These are:
+
+scripgrid.exe (scripgrid.F90) which creates two grid description files suitable for
+input to the scrip package. 
+
+scrip.exe (scrip.F90) which takes these descriptions and generates the required
+weights in the standard SCRIP format. This program is a version of the SCRIP
+program: scrip.f which has been modified to accept the name of its namelist
+file on the command line.
+
+scripshape.exe (scripshape.F90) which takes the output from scrip and rearranges
+the fields into a series of 2D fields more suited for input into NEMO using
+the iom_get routine.
+
+All three FORTRAN90 programs read domain information from their respective
+netCDF input files and dynamically allocate internal storage. They are
+thus independent of the target configuration and have been successfully
+tested with both ORCA2 and ORCA025 grids. Their suitably for use with larger
+grids has not been tested but should only be subject to limitations of
+the operating system and the memory available to the processing element.
+
+A separate tar file is available containing test data.
+This comprises an ORCA2 coordinates file and sample DFS4.1 input field that
+can be used for testing. Reference weights files generated using the two
+example namelists provided are located in its refout subdirectory.
+
+Installation is by use of the makenemo script.
+
+Example Use
+-----------
+
+  cd data
+  scripgrid.exe namelist_reshape_bilin    (creates remap_data_grid.nc 
+                                              and remap_nemo_grid.nc)
+  scrip.exe     namelist_reshape_bilin        (creates data_nemo_bilin.nc)
+
+  scripshape.exe data_nemo_bilin.nc reshape_orca2_bilinear.nc  
+                                             (creates reshape_orca2_bilinear.nc)
+  
+[Note that because the gfortran compiler does not understand the iargc function 
+and getarg subroutine calls, command line namelist names can only be supplied if
+symbol ARGC is defined during compilation (eg add '#define ARGC' to the top of 
+the relevant program).  If not, the program asks for the name instead during execution.]
+
+Only the final output file is required for use with NEMO but the intermediate
+files can be checked against the examples in the test data (available separately).
+
+For bicubic mapping only scrip and scripshape need to be rerun (because the grid_inputs namelist
+entries are identical in the two namelist files, see Controls section below):
+ 
+  ../bin/scrip namelist_reshape_bicubic      (creates data_nemo_bicubic.nc)
+
+  ../bin/scripshape data_nemo_bicubic.nc reshape_orca2_bicubic.nc  
+                                             (creates reshape_orca2_bicubic.nc)
+
+Controls
+--------
+
+The SCRIP derived utilities use SCRIP-style namelists to control their
+operation.  In the example above the same named file is used for both but within that
+file are two separate namelists:
+
+&grid_inputs
+    input_file = './snow_1m_TRP_1958.nc'
+    nemo_file = 'coordinates.nc'
+    datagrid_file = 'remap_data_grid.nc'
+    nemogrid_file = 'remap_nemo_grid.nc'
+    method = 'regular'
+    input_lon = 'lon'
+    input_lat = 'lat'
+    nemo_lon = 'glamt'
+    nemo_lat = 'gphit'
+    nemo_mask = 'none'
+    nemo_mask_value = 10
+    input_mask = 'none'
+    input_mask_value = 10
+/
+
+which is used by scripgrid, and:
+
+&remap_inputs
+    num_maps = 1
+    grid1_file = 'remap_data_grid.nc'
+    grid2_file = 'remap_nemo_grid.nc'
+    interp_file1 = 'data_nemo_bilin.nc'
+    interp_file2 = 'nemo_data_bilin.nc'
+    map1_name = 'data to nemo bilin Mapping'
+    map2_name = 'nemo to data bilin Mapping'
+    map_method = 'bilinear'
+    normalize_opt = 'frac'
+    output_opt = 'scrip'
+    restrict_type = 'latitude'
+    num_srch_bins = 90
+    luse_grid1_area = .false.
+    luse_grid2_area = .false.
+/
+
+which is used by scrip.
+
+scripshape also reads information from a namelist:
+
+&shape_inputs
+    interp_file = 'data_nemo_bilin.nc'
+    output_file = 'weights_bilin.nc'
+    ew_wrap     = 0
+/
+
+scripgrid.exe
+-------------
+
+scripgrid accesses the named files and coordinate data in order to produce
+the grid centre and corner locations required by scrip. In the example given,
+a file called 'coordinates.nc' must exist in the current directory. This is
+recognised by scripgrid as a nemo coordinates file and the correct corner
+locations appropriate to the named grid centres are obtained (i.e. since
+glamt is named, glamf and gphif will be used to provide corner coordinates).
+"input_file" file must contain at least one variable on a grid whose axes are
+described by the netcdf coordinate variables named in input_lon and input_lat.
+The program produces two grid description files, one corresponding to each
+input file, for use by the scrip program to calculate weights required to
+go from one to the other and back again.
+
+This step is independent of the mapping method (e.g. bilinear or bicubic)
+and so only one set of remap_data_grid.nc and remap_nemo_grid.nc files needs
+to be produced for each pair of source and destination grids.
+
+scrip.exe
+---------
+
+scrip takes the output files from scripgrid and creates a file of weights
+to use to interpolate between the two grids described. The example given
+only requests 1 map (from data to nemo); setting num_maps=2 will provide
+the reverse weights if required.
+ 
+ - num_maps is either 1 or 2 depending on whether the reverse 
+    transformation is required 
+
+ - grid1_file, grid2_file: two remap grid files are required 
+    as output by scripgrid
+
+ - interp_file1, interp_file2: one or two interp_file names are 
+    then supplied; these hold the weights to convert one grid to another
+
+ - map1_name, map2_name: the map_name variables are just descriptive
+
+ - map_method: can be 'bilinear' or 'bicubic'
+
+ - normalize_opt: should usually be 'frac' or else the user needs to do  
+    this scaling manually (this seems to the case for fractional ice cover)
+
+ - output_opt may be supplied and set to either 'scrip' or 'ncar-csm'
+
+ - restrict_type: should be 'latitude' or 'latlon' in which case 
+    num_srch_bins only are used in one or two directions
+
+ - use_grid_area fields override the scrip calculation of area in 
+    case the model gets slightly different answers, but the area needs 
+    to be supplied in the input files
+
+A conservative mapping scheme exists but is not yet working with NEMO grids.
+See the scrip package documentation for more details of these parameters.
+(http://climate.lanl.gov/Software/SCRIP/SCRIPusers.pdf)
+
+scripshape.exe
+--------------
+
+scripshape takes the output from scrip (e.g. data_nemo_bilin.nc ) and
+rearranges the source and destination indices and associated weights into
+sets of 2D fields each spanning the nemo grid. Each set is associated with
+each node involved in the interpolation scheme.  Thus for a bilinear mapping
+the weights file required by the IOF option includes the following fields:
+
+  double src01(lat, lon) ;   double dst01(lat, lon) ;   double wgt01(lat, lon) ;
+  double src02(lat, lon) ;   double dst02(lat, lon) ;   double wgt02(lat, lon) ;
+  double src03(lat, lon) ;   double dst03(lat, lon) ;   double wgt03(lat, lon) ;
+  double src04(lat, lon) ;   double dst04(lat, lon) ;   double wgt04(lat, lon) ;
+
+For a bicubic mapping the required fields are:
+
+  double src01(lat, lon) ;   double dst01(lat, lon) ;   double wgt01(lat, lon) ;
+  double src02(lat, lon) ;   double dst02(lat, lon) ;   double wgt02(lat, lon) ;
+  double src03(lat, lon) ;   double dst03(lat, lon) ;   double wgt03(lat, lon) ;
+  double src04(lat, lon) ;   double dst04(lat, lon) ;   double wgt04(lat, lon) ;
+  double src05(lat, lon) ;   double dst05(lat, lon) ;   double wgt05(lat, lon) ;
+  double src06(lat, lon) ;   double dst06(lat, lon) ;   double wgt06(lat, lon) ;
+  double src07(lat, lon) ;   double dst07(lat, lon) ;   double wgt07(lat, lon) ;
+  double src08(lat, lon) ;   double dst08(lat, lon) ;   double wgt08(lat, lon) ;
+  double src09(lat, lon) ;   double dst09(lat, lon) ;   double wgt09(lat, lon) ;
+  double src10(lat, lon) ;   double dst10(lat, lon) ;   double wgt10(lat, lon) ;
+  double src11(lat, lon) ;   double dst11(lat, lon) ;   double wgt11(lat, lon) ;
+  double src12(lat, lon) ;   double dst12(lat, lon) ;   double wgt12(lat, lon) ;
+  double src13(lat, lon) ;   double dst13(lat, lon) ;   double wgt13(lat, lon) ;
+  double src14(lat, lon) ;   double dst14(lat, lon) ;   double wgt14(lat, lon) ;
+  double src15(lat, lon) ;   double dst15(lat, lon) ;   double wgt15(lat, lon) ;
+  double src16(lat, lon) ;   double dst16(lat, lon) ;   double wgt16(lat, lon) ;
+
+This program also adds an attribute to the weights file for use by the fld_interp
+routine in fldread.F90.  This tells the model about the east-west cyclicity of the source grid.
+The value needs to be supplied in the scripshape namelist via the variable ew_wrap.
+It should have one of the values -1, 0, 1 or 2.  -1 means that the input grid is not
+cyclic; 0 means that it is cyclic but with no overlapping columns; and a value greater
+than zero represents the number of columns that overlap.  In fact it only has an effect 
+when using bicubic interpolation in which the model needs to know which additional columns
+have to be read in to correctly calculate gradient values.
+The weights file produced by scripshape is ready for use in NEMO. This file
+needs to by placed in the nemo working directory and needs to be named in the
+appropriate SBC namelist entry (e.g. namsbc_clio, namsbc_flux or namsbc_core).
+
+scripinterp.exe
+---------------
+
+Take data on an input grid and interpolate to the nemo grid using the weights
+calculated by the scrip program.
+Method
+Two namelists are used for configuration, eg
+
+&interp_inputs
+    input_file = "../data/wsx_av.nc"
+    interp_file = "data_nemo_bilin.nc"
+    input_name = "wsx"
+    input_start = 1,1,1,1
+    input_stride = 1,1,1,1
+    input_stop = 0,0,0,1
+    input_vars = 'time'
+/
+
+&interp_outputs
+    output_file = "taux_1m.nc"
+    output_mode = "create"
+    output_dims = 'x', 'y', 'time_counter'
+    output_scaling = "sozotaux|1.0", "time_counter|86400.0"
+    output_name = 'sozotaux'
+    output_lon = 'x'
+    output_lat = 'y'
+    output_vars = 'time_counter'
+    output_attributes = 'time_counter|units|seconds since 1995-00-00 00:00:00',
+                        'time_counter|calendar|noleap',
+                        'sozotaux|units|N/m2'
+/
+
+This program just multiplies by weights and sums over each contributing point,
+and then formats the output correctly for the model.
+
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/.log.dti
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/.log.dti	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/.log.dti	(revision 2352)
@@ -0,0 +1,16 @@
+96/10/22 13:08:53 opened .log.dti
+96/10/22 13:08:53 debug explicitly set to 0
+96/10/22 13:08:58 opened .log.dti
+96/10/22 13:08:58 debug explicitly set to 0
+96/10/22 13:09:56 opened .log.dti
+96/10/22 13:09:56 debug explicitly set to 0
+96/11/18 11:29:28 opened .log.dti
+96/11/18 11:29:28 debug explicitly set to 0
+96/11/18 11:29:31 opened .log.dti
+96/11/18 11:29:31 debug explicitly set to 0
+96/11/18 11:31:34 opened .log.dti
+96/11/18 11:31:34 debug explicitly set to 0
+96/11/20 09:09:51 opened .log.dti
+96/11/20 09:09:51 debug explicitly set to 0
+96/11/20 09:09:55 opened .log.dti
+96/11/20 09:09:55 debug explicitly set to 0
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/bugs
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/bugs	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/bugs	(revision 2352)
@@ -0,0 +1,58 @@
+************************************************************************
+
+Bug or issue                                          Reported   Fixed
+----------------------------------------------------  --------  --------
+
+Outstanding:
+
+Need parallel implementation of SCRIP                 07/01/00
+Latitude bins not very robust for sparse grids        10/27/98
+Deal with extrapolation for bilinear, bicubic         12/02/98
+Remove cyclic bndy assumptions from bilin, bicubic    12/02/98
+Problem with coordinate transform when both grids 
+  contain pole point as cell edge (note that in
+  such a case, turning off the coordinate transform
+  by setting thresholds >pi, <-pi may fix this)       12/03/98
+Bug in test configuration when SH transformation on   12/03/98
+
+Fixed in release 1.4:
+
+Conversion from polar projection back to lat/lon
+  space extremely sensitive near pole                 07/01/01  08/20/01
+Bilinear/cubic fails when cells overlap longitude cut 08/13/01  08/20/01
+Bilinear/cubic iteration converges to bad solution
+  for skewed cells                                    08/21/01  08/21/01
+Nearest-neighbor backup to bilinear/cubic fails       08/13/01  08/20/01
+Added feature to use input areas for normalization    06/20/00  07/01/00
+Added error checks on weights for conservative maps   06/20/00  07/01/00
+
+Fixed in release 1.3:
+
+Added new binning options to restrict searches        ...do not know...
+Optimized code for resizing arrays                    .................
+
+Fixed in release 1.2:
+
+Changed namelist input for map type to character      05/31/99  06/04/99
+Added new output option for CSM coupler               05/31/99  06/04/99
+Added additional normalization options for conserv    05/31/99  06/04/99
+Improper handling of grid pairs which share corners   01/29/99  02/04/99
+Uninitialized variables and subscripts out of range   01/22/99  01/25/99
+
+Fixed in release 1.1:
+
+Conservative remap assumed num_maps = 2               12/16/98  12/17/98
+Change units of grid quantities back to input units   12/04/98  12/17/98
+Add option for unnormalized conservative weights      12/04/98  12/17/98
+Update user's guide for recent changes                12/02/98  12/17/98
+Add different test fields                             11/18/98  12/02/98
+Add support for multiple remap test                   11/18/98  12/02/98
+Add bicubic module                                    11/18/98  12/17/98
+
+Fixed in release 1.02:
+
+Problems setting up latitude bins for polar cells     10/22/98  10/27/98
+Input latitudes out of range (due to machine pi/2)    10/27/98  10/27/98
+Bad coordinate transformation in south pole           10/22/98  11/02/98
+
+************************************************************************
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/doc/SCRIPusers.tex
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/doc/SCRIPusers.tex	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/doc/SCRIPusers.tex	(revision 2352)
@@ -0,0 +1,1113 @@
+\documentclass[12pt]{report}
+
+\title{A User's Guide for SCRIP: A {\em S}pherical {\em C}oordinate
+       {\em R}empping and {\em I}nterpolation {\em P}ackage }
+
+\author{Philip W. Jones}
+
+\begin{document}
+
+%\maketitle
+
+\begin{titlepage}
+
+\vspace{1in}
+
+\begin{center}
+{\Large{A User's Guide for SCRIP: A {\em S}pherical {\em C}oordinate
+       {\em R}emapping and {\em I}nterpolation {\em P}ackage }}
+\end{center}
+
+\vspace{1in}
+
+\begin{center}
+Version 1.4
+\end{center}
+
+\vspace{1in}
+
+\begin{center}
+Philip W. Jones \\
+Theoretical Division \\
+Los Alamos National Laboratory
+\end{center}
+
+\newpage
+
+\begin{center}
+{\bf COPYRIGHT NOTICE}
+\end{center}
+
+Copyright \copyright 1997, 1998 the Regents of the University of
+California.
+
+\vspace{0.5in}
+
+This software and ancillary information (herein called SOFTWARE) called
+SCRIP is made available under the terms described here.  The SOFTWARE
+has been approved for release with associated LA-CC Number 98-45.
+
+Unless otherwise indicated, this SOFTWARE has been authored by an
+employee or employees of the University of California, operator
+of Los Alamos National Laboratory under Contract No. W-7405-ENG-36
+with the United States Department of Energy.  The United States
+Government has rights to use, reproduce, and distribute this
+SOFTWARE.  The public may copy, distribute, prepare derivative
+works and publicly display this SOFTWARE without charge, provided
+that this Notice and any statement of authorship are reproduced
+on all copies.  Neither the Government nor the University makes
+any warranty, express or implied, or assumes any liability or
+responsibility for the use of this SOFTWARE.
+
+If SOFTWARE is modified to produce derivative works, such modified
+SOFTWARE should be clearly marked, so as not to confuse it with the
+version available from Los Alamos National Laboratory.
+
+
+\end{titlepage}
+
+\tableofcontents
+
+\chapter{Introduction}
+
+SCRIP is a software package used to generate interpolation weights
+for remapping fields from one grid to another in spherical geometry.
+The package currently supports four types of remappings.  The
+first is a conservative remapping scheme that
+is ideally suited to a coupled model context where the area-integrated
+field (e.g. water or heat flux) must be conserved.  The second
+type of mapping is a basic bilinear interpolation which has
+been slightly generalized to perform a local bilinear interpolation.
+A third method is a bicubic interpolation similar to the
+bilinear method.
+The last type of remapping is a distance-weighted average of
+nearest-neighbor points.  The bilinear and bicubic schemes can
+only be used with logically-rectangular grids; the other two methods
+can be used for any grid in spherical coordinates.
+
+SCRIP is available via the web at \newline
+http://climate.acl.lanl.gov/software/SCRIP/ \newline
+NOTE: This location has changed since the 1.2 release.
+
+The next chapter describes how to compile and run SCRIP, while
+the following sections describe the remapping methods in more
+detail.
+
+\chapter{Compiling and Running}
+
+The distribution file is a gzipped tarfile, so you must
+uncompress the file using ``gunzip'' and then extract SCRIP
+from the tar file using ``tar -xvf scrip1.4.tar''.  The extraction
+process will create a directory called SCRIP with two
+subdirectories named ``source'' and ``grids''.  The source
+directory contains all the source files and the makefile
+for building the package.  The grids directory contains
+some sample grid files and routines for creating or
+converting other grid files to the proper format.
+
+\section{Compiling}
+
+In order to compile SCRIP, you need access to a
+Fortran 90 compiler and a netCDF library (version 3 or
+later).  In the source directory, you must edit the
+makefile to insert the appropriate compiler and compiler
+options for whatever machine you happen to work on.  The
+makefile currently only has SGI compiler options.  In
+addition, you must edit the paths in the makefile to
+find the proper netCDF library - if netCDF is in your
+default path, you may delete the path altogether.
+
+Once the makefile has been edited to reflect your
+local environment, type ``make'' and let it
+build.  By default, the makefile builds two executables
+in the main SCRIP directory;
+the first executable is called scrip and computes
+all the necessary weights for a remapping.  The second
+executable is a simple test code scrip\_test which will
+test the weights output by scrip.
+
+\subsection{Compile-time Parameters}
+
+There are a few compile-time parameters that can
+be changed before compiling (see Table~\ref{tab:params}).
+For the most part, the
+defaults are adequate, but you may wish to change
+these at some point.  The use of these parameters
+will become clear in the chapters describing the
+remapping algorithms.
+
+\begin{table}
+\caption{Compile-time parameters \label{tab:params}}
+
+\begin{tabular}{|l|l|c|l|} \hline
+     Routine       &    Parameter     &  Default & Description  \\
+                   &      Name        &   Value  &              \\ \hline
+remap\_conserv.f   &  north\_thresh   &   1.42   &  threshold latitude (in  \\
+                   &                  &          &  radians) above which a  \\
+                   &                  &          &  coordinate transformation \\
+                   &                  &          &  is used to perform       \\
+                   &                  &          &  intersection calculation \\ \hline
+remap\_conserv.f   &  south\_thresh   &  -2.00   &  same for south pole \\ \hline
+remap\_conserv.f   &  max\_subseg     &  10000   &  maximum number of sub-  \\
+                   &                  &          &  segments allowed (to    \\
+                   &                  &          &  prevent infinite loop)  \\
+\hline
+remap\_bilinear.f  &  max\_iter       &   100    &  max number of iterations \\
+                   &                  &          &  to determine local i,j   \\ \hline
+remap\_bilinear.f  &  converge        & $1\times 10^{-10}$
+                                                 &  convergence criterion   \\
+                   &                  &          &  for bilinear iteration  \\
+\hline
+remap\_bicubic.f   &  max\_iter       &   100    &  max number of iterations \\
+                   &                  &          &  to determine local i,j   \\ \hline
+remap\_bicubic.f   &  converge        & $1\times 10^{-10}$
+                                                 &  convergence criterion   \\
+                   &                  &          &  for bicubic iteration  \\
+\hline
+remap\_distwgt.f   &  num\_neighbors  &    4     &  number of nearest       \\
+                   &                  &          &  neighbors to use for    \\
+                   &                  &          &  distance-weighted average\\
+\hline
+iounits.f          &  stdin           &    5     &  I/O unit reserved for \\
+                   &                  &          &  standard input \\ \hline
+iounits.f          &  stdout          &    6     &  I/O unit reserved for \\
+                   &                  &          &  standard output \\ \hline
+iounits.f          &  stderr          &    6     &  I/O unit reserved for \\
+                   &                  &          &  standard error output \\
+\hline
+timers.f           &  max\_timers     &   99     &  max number of CPU timers \\
+\hline
+\end{tabular}
+\end{table}
+
+\section{Running}
+
+Once the code is compiled, a few input files are needed.
+The first is a namelist input file and the other two
+required files are grid description files.
+
+\subsection{Namelist Input}
+
+The namelist input file must be called scrip\_in
+and contain a namelist as shown in Fig.~\ref{fig:nml}.
+
+\begin{figure}
+\caption{Required input namelist. \label{fig:nml}}
+\begin{verbatim}
+&remap_inputs
+    num_maps = 2
+    grid1_file = 'grid_1_file_name'
+    grid2_file = 'grid_2_file_name'
+    interp_file1 = 'map_1_output_file_name'
+    interp_file2 = 'map_2_output_file_name'
+    map1_name = 'name_for_mapping_1'
+    map2_name = 'name_for_mapping_2'
+    map_method = 'conservative'
+    normalize_opt = 'frac'
+    output_opt = 'scrip'
+    restrict_type = 'latitude'
+    num_srch_bins = 90
+    luse_grid1_area = .false.
+    luse_grid2_area = .false.
+/
+\end{verbatim}
+\end{figure}
+
+The num\_maps variable determines the number of mappings
+to be computed.  If you'd like mappings only from a source
+grid (grid 1) to a destination grid (grid 2), then
+num\_maps should be set to one.  If you'd also like weights
+for a remapping in the opposite direction (grid 2 to grid 1),
+then num\_maps should be set to two.
+
+The map\_method variable determines the method to be used
+for the mapping.  A conservative remapping is map\_method
+`conservative'; a bilinear mapping is map\_method `bilinear';
+a distance-weighted average is map\_method `distwgt'; a
+bicubic mapping is map\_method `bicubic'.
+
+The restrict\_type variable and num\_srch\_bins determines
+how the software restricts the range of grid points to search
+to avoid a full $N^2$ search.  There are currently two options
+for restrict\_type: `latitude' and `latlon'.  The first was used in
+all previous versions of SCRIP and restricts the search by
+dividing the grid points into num\_srch\_bins latitude bins.
+The `latlon' choice divides the spherical domain into
+latitude-longitude boxes and thus provides a way to
+restrict the longitude range as well.  Note that for the latlon
+option, the domain is divided by num\_srch\_bins in
+{\em each} direction so that the total number of bins is the
+square of num\_srch\_bins.  Generally, the larger the number
+of bins, the more the search can be restricted.  However if
+the number of bins is too large, more time will be taken
+restricting the search than the search itself.  For coarse
+grids, choosing the latitude option with 90 bins (one degree
+bins) is sufficient.
+
+The normalize\_opt variable is used to choose the normalization
+of the remappings for the conservative remapping method.
+By default, normalize\_opt is set to be `fracarea' and will
+include the destination area fraction in the output weights;
+other options are `none' and `destarea' (see chapter on the
+conservative remapping method). The latter two are useful when
+dealing with masks that are dynamic (e.g. variable ice fraction).
+Keep in mind that in such a case, the
+area fractions must be computed explicitly by the remapping
+routine at the time the remappings are actually computed
+(see the example in Fig.~\ref{fig:rmpfort}).
+
+The grid{\em x}\_file are names (with relative paths) of
+the grid input files.  The first grid file (grid1\_file)
+{\em must} be the source grid if num\_maps=1.  If this
+mapping uses the conservative remapping method, the first
+grid file must also be the grid with the master mask
+(e.g. a land mask) -- grid fractions on the second grid
+will be determined by this mask.
+
+Names of the output files for the remapping weights are
+determined by the interp\_file{\em x} filenames (again
+with paths).  Map 1 refers to a mapping from grid 1 to
+grid 2; map 2 is in the opposite direction.
+
+A descriptive name for the remappings are determined by
+the map{\em x}\_name variables.  These should be
+descriptive enough to know exactly which grids and
+methods were used.
+
+The output\_opt variable determines the format of the
+netCDF output file.  The two currently-supported options
+are `scrip' and `ncar-csm'.  The latter is to generate
+files for use in the NCAR CSM Flux Coupler for coupled
+climate modeling.  The primary difference between the
+formats is the choice of variable names.
+
+The two logical flags luse\_grid{\em x}\_area are
+for using an input area to normalize the conservative
+weights.  If these are set to true, the input grid
+files must contain the grid areas.  This option is
+provided primarily for making the weights consistent
+with internal model-computed areas (which may differ
+somewhat from the SCRIP-computed areas).
+
+\subsection{Grid Input Files}
+
+The grid input files are in netCDF format as shown
+by the sample ncdump grid output in Fig.~\ref{fig:ncgrid}.
+If you're unfamiliar with ncdump output, it's important to
+not that ncdump shows the array dimensions in C ordering.
+In Fortran, the order is reversed (e.g. arrays are
+dimensioned (grid\_corners,grid\_size).
+In the grids subdirectory of the distribution there
+are some fortran source codes for creating these
+grid files for some special cases.  See the README
+file in that subdirectory for details.
+
+\begin{figure}
+\caption{A sample input grid file. \label{fig:ncgrid}}
+\begin{verbatim}
+netcdf remap_grid_T42 {
+dimensions:
+        grid_size = 8192 ;
+        grid_corners = 4 ;
+        grid_rank = 2 ;
+
+variables:
+        long grid_dims(grid_rank) ;
+        double grid_center_lat(grid_size) ;
+                grid_center_lat:units = "radians" ;
+        double grid_center_lon(grid_size) ;
+                grid_center_lon:units = "radians" ;
+        long grid_imask(grid_size) ;
+                grid_imask:units = "unitless" ;
+        double grid_corner_lat(grid_size, grid_corners) ;
+                grid_corner_lat:units = "radians" ;
+        double grid_corner_lon(grid_size, grid_corners) ;
+                grid_corner_lon:units = "radians" ;
+
+// global attributes:
+                :title = "T42 Gaussian Grid" ;
+}
+\end{verbatim}
+\end{figure}
+
+The name of the grid is given as the title and will be used
+to specify the grid name throughout the remapping process.
+
+The grid\_size dimension is the total size of the grid; grid\_rank
+refers to the number of dimensions the grid array would have
+when used in a model code.  The number of corners (vertices) in
+each grid cell is given by grid\_corners.  Note that if your
+grid has a variable number of corners on grid cells, then you
+should set grid\_corners to be the highest value and use
+redundant points on cells with fewer corners.
+
+The integer array grid\_dims gives the length of each
+grid axis when used in a model code.  Because the remapping
+routines read the grid properties as a linear list of
+grid cells, the grid\_dims array is necessary for
+reconstructing the grid, particularly for a bilinear mapping
+where a logically rectangular structure is needed.
+
+The integer array grid\_imask is used to mask out grid cells
+which should not participate in the remapping.  The array
+should by zero for any points (e.g. land points) that do
+not participate in the remapping and one for all other points.
+
+Coordinate arrays provide the latitudes and longitudes of
+cell centers and cell corners.  Although the above reports
+the units as ``radians'', the code happily accepts ``degrees''
+as well.  The grid corner coordinates {\em must} be
+written in an order which traces the outside of a grid
+cell in a counterclockwise sense.  That is, when moving
+from corner 1 to corner 2 to corner 3, etc., the grid
+cell interior must always be to the left.
+
+\subsection{Output Files}
+
+The remapping output files are also in netCDF format
+and contain some grid information from each grid
+as well as the remapping addresses and weights.  An example
+ncdump of the output files is shown in Fig.~\ref{fig:ncrmp}.
+
+\begin{figure}
+\caption{A sample output file for mapping data in scrip format.
+\label{fig:ncrmp}}
+\begin{verbatim}
+netcdf rmp_POP43_to_T42_cnsrv {
+dimensions:
+        src_grid_size = 24576 ; dst_grid_size = 8192 ;
+        src_grid_corners = 4  ; dst_grid_corners = 4 ;
+        src_grid_rank = 2     ; dst_grid_rank = 2 ;
+        num_links = 42461 ; num_wgts = 3 ;
+variables:
+        long src_grid_dims(src_grid_rank) ;
+        long dst_grid_dims(dst_grid_rank) ;
+        double src_grid_center_lat(src_grid_size) ;
+        double dst_grid_center_lat(dst_grid_size) ;
+        double src_grid_center_lon(src_grid_size) ;
+        double dst_grid_center_lon(dst_grid_size) ;
+        long src_grid_imask(src_grid_size) ;
+        long dst_grid_imask(dst_grid_size) ;
+        double src_grid_corner_lat(src_grid_size, src_grid_corners) ;
+        double src_grid_corner_lon(src_grid_size, src_grid_corners) ;
+        double dst_grid_corner_lat(dst_grid_size, dst_grid_corners) ;
+        double dst_grid_corner_lon(dst_grid_size, dst_grid_corners) ;
+        double src_grid_area(src_grid_size) ;
+                src_grid_area:units = "square radians" ;
+        double dst_grid_area(dst_grid_size) ;
+                dst_grid_area:units = "square radians" ;
+        double src_grid_frac(src_grid_size) ;
+        double dst_grid_frac(dst_grid_size) ;
+        long src_address(num_links) ;
+        long dst_address(num_links) ;
+        double remap_matrix(num_links, num_wgts) ;
+// global attributes:
+         :title = "POP 4/3 to T42 Conservative Mapping" ;
+         :normalization = "fracarea" ;
+         :map_method = "Conservative remapping" ;
+         :history = "Created: 07-19-1999" ;
+         :conventions = "SCRIP" ;
+         :source_grid = "POP 4/3 Displaced-Pole T grid" ;
+         :dest_grid = "T42 Gaussian Grid" ;
+}
+\end{verbatim}
+\end{figure}
+
+The grid information is simply echoing the input grid file
+information and adding grid\_area and grid\_frac arrays.
+The grid\_area array currently is {\em only} computed by
+the conservative remapping option; the others will write
+arrays full of zeros for this field.  The grid\_frac array
+for the conservative remapping returns the area fraction
+of the grid cell which participates in the remapping based
+on the source grid mask.  For the other two remapping options,
+the grid\_frac array is one where the grid point participates
+in the remapping and zero otherwise, based again on the
+source grid mask (and {\em not} on the grid\_imask for that
+grid).
+
+The remapping data itself is written as if for a sparse matrix
+multiplication.  Again, the Fortran array must be dimensioned
+(num\_wgts,num\_links) rather than the C order shown in the
+ncdump.  The dimension num\_wgts refers to the number
+of weights for a given remapping and is one for bilinear and
+distance-weighted remappings.  For the conservative
+remapping, num\_wgts is 3 as it contains two additional
+weights for a second-order remapping.  The bicubic remappings
+require four weights as for gradients in each direction plus
+a term for the cross gradient.  The dimension num\_links
+is the number of unique address pairs in the remapping and is
+therefore the number of entries in a sparse matrix for the
+remapping.  The integer address arrays contain the source
+and destination address for each ``link''.  So, a Fortran code
+to complete the conservative remappings might look like that
+shown in Fig.~\ref{fig:rmpfort}.
+
+\begin{figure}
+\caption{Sample Fortran code for performing a first-order
+         conservative remap. \label{fig:rmpfort}}
+\begin{verbatim}
+
+dst_array = 0.0
+
+select case (normalize_opt)
+case ('fracarea')
+
+  do n=1,num_links
+    dst_array(dst_address(n)) = dst_array(dst_address(n)) +
+              remap_matrix(1,n)*src_array(src_address(n))
+  end do
+
+case ('destarea')
+
+  do n=1,num_links
+    dst_array(dst_address(n)) = dst_array(dst_address(n)) +
+             (remap_matrix(1,n)*src_array(src_address(n)))/
+             (dst_frac(dst_address(n)))
+  end do
+
+case ('none')
+
+  do n=1,num_links
+    dst_array(dst_address(n)) = dst_array(dst_address(n)) +
+             (remap_matrix(1,n)*src_array(src_address(n)))/
+       (dst_area(dst_address(n))*dst_frac(dst_address(n)))
+  end do
+
+end select
+
+\end{verbatim}
+\end{figure}
+
+The address arrays are sorted by destination address and are
+linear addresses that assume standard
+Fortran ordering. They can therefore be converted to logical
+address space if necessary.  For example, a point on a
+two-dimensional grid with logical coordinates $(i,j)$ will
+have a linear address $n$ given by
+$n=(j-1)*{\rm grid\_dims(1)} + i.$  Alternatively, if the
+code is run on a serial machine, the multi-dimensional arrays
+can be passed into linear dummy arrays and the addresses can
+be used directly.  Such a storage/sequence association may
+not be valid in a distributed-memory context however.
+The scrip\_test code shows an example of how the remappings
+can be implemented.
+
+\section{Testing}
+
+In order to test the weights computed by the SCRIP package,
+a simple test code is provided.  This code reads in the
+weights and remaps analytic fields.  Three choices for the
+analytic field are provided.  The first is a cosine bell
+function $f=2+\cos(\pi r/L)$, where $r$ is the distance from
+the center of the hill and $L$ is a length scale.  Such a
+function is useful for determining the effects of repeated
+applications.  The other two fields are representative of
+spherical harmonic wavefunctions.  A relatively smooth function
+$f=2+\cos^2\theta\cos(2\phi)$ is similar to a spherical
+harmonic with $\ell=2$ and $m=2$, where $\ell$ is the
+spherical harmonic order and $m$ is the azimuthal wave number.
+The function
+$f=2+\sin^{16}(2\theta)\cos(16\phi)$ is similar to a
+spherical harmonic with $\ell=32$ and $m=16$ and is useful
+for testing a field with relatively high spatial
+frequency and rapidly changing gradients.  The choice of
+which field is remapped in determined by the input namelist
+scrip\_test\_in.
+
+For
+conservative remappings, the test code tests three different
+remappings: the first is a first-order remapping, the second
+is a second-order remapping using only latitude gradients,
+and the third is a full second-order remapping.  The second
+is performed in order to determine which weights are
+causing problems when errors occur.  The code
+prints out three diagnostics to standard output and writes
+many quantities to a netCDF output file.
+
+First, it prints out the minimum and maximum of the source
+and destination (remapped) fields.  This is a test for
+monotonicity (although only the first-order conservative
+remapping is monotone by default).
+
+Second, the test code prints out the maximum and average
+relative error $\epsilon =
+|(F_{dst} - F_{analytic})/F_{analytic}|$, where
+$F_{analytic}$ is the source function evaluated at the
+destination grid points and $F_{dst}$ is the destination
+(remapped) field.  The errors here can sometimes be misleading.
+For example, if a conservative remapping is performed from
+a fine grid to a coarse grid, the destination array will
+contain the field averaged over many source cells, while
+$F_{analytic}$ is the analytic field evaluated at the cell
+center point.  Another instance which leads to relatively
+large errors is near mask boundaries where the remapped
+field is correctly returning values indicative of the edge
+of a grid cell, while $F_{analytic}$ is again computing
+cell-center values. To avoid the latter problem, the error is
+only computed where the destination grid fraction
+is greater than $0.999$.
+
+Lastly, the test code prints out the area-integrated
+field on the source and destination grids in order to
+test conservation.  This diagnostic returns zeros for
+all but conservative remappings.  For a first-order
+conservative remapping, these numbers should agree
+to machine accuracy.  For a second-order conservative
+remapping, they will be very close, but may not exactly
+agree due to mask boundary effects where it is not
+possible to perform the exact area integral.
+
+The netCDF output file from the test code contains
+the source and destination arrays as well as the
+error arrays so the error can be examined at every
+grid point to pinpoint problems.  The arrays in
+the netCDF file are written out in arrays with
+rank grid\_rank (e.g. two-dimensional grids are
+written as proper 2-d arrays rather than vectors
+of values).  These arrays can then be viewed using
+any visualization package.
+
+\chapter{Conservative Remapping}
+
+The SCRIP package implements a conservative remapping
+scheme described in detail in a separate paper
+(Jones, P.W. 1999 {\em Monthly Weather Review}, 
+{\bf 127}, 2204-2210).
+A brief outline will be given here to aid the
+user in understanding what this portion of the
+package does.
+
+To compute a flux on a new (destination) grid which
+results in the same energy or water exchange as a flux $f$ on an
+old (source) grid, the destination flux $F$ at a destination grid
+cell $k$ must satisfy
+\begin{equation}\label{eq:local}
+\overline{F}_k = {1\over{A_k}}\int\int_{A_k} fdA,
+\end{equation}
+where $\overline{F}$ is the area-averaged flux and $A_k$ is
+the area of cell $k$.
+Because the integral in (\ref{eq:local}) is over the area of
+the destination grid cell, only those cells on the source grid
+that are covered at least partly by the destination grid cell
+contribute to the value of the flux on the destination grid.
+If cell $k$ overlaps $N$ cells on the source grid, the
+remapping can be written as
+\begin{equation}\label{eq:rmpsum}
+\overline{F}_k =
+{1\over{A_k}} \sum_{n=1}^N \int\int_{A_{nk}} f_ndA,
+\end{equation}
+where $A_{nk}$ is the
+area of the source grid cell $n$ covered by the destination grid
+cell $k$, and $f_n$ is the local value of the flux in the source
+grid cell (see Figure~\ref{fig:grids}).  Note that (\ref{eq:rmpsum})
+is normalized by the destination area $A_k$ corresponding to
+the normalize\_opt value of `destarea'.  The sum of the weights
+for a destination cell $k$ in this case would be between 0 and 1
+and would be the area fraction if $f_n$ were identically 1
+everywhere on the source grid.  The normalization option
+`fracarea' would actually divide by the area of the source
+grid overlapped by cell $k$:
+\begin{equation}
+\sum_{n=1}^N \int\int_{A_{nk}}dA.
+\end{equation}
+For this normalization option, remapping a function $f$ which
+is 1 everywhere on the source grid would result in a function
+$F$ that is exactly one wherever the destination grid overlaps
+a non-masked source grid cell and zero otherwise.  A normalization
+option of `none' would result in the actual angular area
+participating in the remapping.
+
+Assuming $f_n$ is constant across a source grid cell,
+(\ref{eq:rmpsum})
+would lead to the first-order area-weighted schemes used in
+current coupled models.  A more accurate form of the remapping
+is obtained by using
+\begin{equation}\label{eq:gradient}
+f_n = \overline{f}_n +
+                   \nabla_n f\cdot({\vec{r}} - \vec{r}_n),
+\end{equation}
+where $\nabla_n f$ is the gradient of the flux in cell $n$ and
+$\vec{r}_n$ is the centroid of cell $n$ defined by
+\begin{equation}\label{eq:centroid}
+\vec{r}_n = {1\over{A_n}}\int\int_{A_n}\vec{r}dA.
+\end{equation}
+Such a distribution satisfies the conservation constraint and
+is equivalent to the first terms of a Taylor series expansion
+of $f$ around $\vec{r}_n$.  The remapping is thus
+second-order accurate if $\nabla_n f$ is at least a
+first-order approximation to the gradient.
+
+The remapping can now be expanded in spherical coordinates as
+\begin{equation}\label{eq:remap}
+\overline{F}_k = \sum_{n=1}^{N} \left[\overline{f}_n w_{1nk} +
+\left({{\partial f}\over{\partial \theta}}\right)_n w_{2nk} +
+\left({1\over{\cos\theta}}{{\partial f}\over{\partial \phi}}\right)_n w_{3nk}
+\right],
+\end{equation}
+where $\theta$ is latitude, $\phi$ is longitude and the
+three remapping weights are
+\begin{equation}\label{eq:weights1}
+w_{1nk} = {1\over{A_k}}\int\int_{A_{nk}}dA, \\
+\end{equation}
+\begin{eqnarray}\label{eq:weights2}
+w_{2nk} & = & {1\over{A_k}}\int\int_{A_{nk}}(\theta-\theta_n)dA \nonumber \\
+        & = & {1\over{A_k}}\int\int_{A_{nk}}\theta dA -
+              {{w_{1nk}}\over{A_n}}\int\int_{A_n}\theta dA,
+\end{eqnarray}
+and
+\begin{eqnarray}\label{eq:weights3}
+w_{3nk} & = & {1\over{A_k}}\int\int_{A_{nk}}\cos\theta(\phi-\phi_n)dA \nonumber \\
+        & = & {1\over{A_k}}\int\int_{A_{nk}}\phi\cos\theta dA -
+              {{w_{1nk}}\over{A_n}}\int\int_{A_n}\phi\cos\theta dA .
+\end{eqnarray}
+Again, if the gradient is zero, ({\ref{eq:remap}})
+reduces to a first-order area-weighted remapping.
+
+The area integrals in
+equations~(\ref{eq:weights1})--(\ref{eq:weights3})
+are computed by converting the area integrals into line
+integrals using the divergence theorem.
+Computing line integrals around the overlap regions
+is much simpler; one simply integrates first around every
+grid cell on the source grid, keeping track of intersections
+with destination grid lines, and then one integrates around every
+grid cell on the destination grid in a similar manner.  After
+the sweep of each grid, all overlap regions have been
+integrated.
+
+Choosing appropriate functions for the divergence, the integrals
+in equations~(\ref{eq:weights1})--(\ref{eq:weights3}) become
+\begin{equation}
+\int\int_{A_{nk}}dA = \oint_{C_{nk}} -\sin\theta d\phi,
+\end{equation}
+\begin{equation}
+\int\int_{A_{nk}}\theta dA =
+ \oint_{C_{nk}} [-\cos\theta-\theta\sin\theta]d\phi,
+\end{equation}
+\begin{equation}
+\int\int_{A_{nk}}\phi\cos\theta dA =
+\oint_{C_{nk}} -{\phi\over 2}[\sin\theta\cos\theta + \theta]d\phi,
+\end{equation}
+where $C_{nk}$ is the counterclockwise path around the region
+$A_{nk}$.  Computing these three line integrals during the
+sweeps of each grid provides all the information necessary
+for computing the remapping weights.
+
+\begin{figure}
+  \caption{An example of a triangular destination grid
+           cell $k$ overlapping
+           a quadrilateral source grid.  The region $A_{kn}$
+           is where cell $k$ overlaps the quadrilateral cell $n$.
+           Vectors
+           used by search and intersection routines are
+           also labelled. \label{fig:grids}}
+
+\begin{picture}(400,400)
+
+\put(100,0){\line(2,1){300}}
+\put(50,100){\line(2,1){300}}
+\put(0,200){\line(2,1){300}}
+%\put(0,150){\line(2,1){400}}
+
+\put(  0,200){\line(1,-2){100}}
+\put(100,250){\line(1,-2){100}}
+\put(200,300){\line(1,-2){100}}
+\put(300,350){\line(1,-2){100}}
+
+
+\put( 50,125){\line(1,0){200}}
+\put(250,125){\line(1,4){40}}
+{\thicklines
+\put(290,285){\vector(-3,-2){240}}
+\put(200,300){\vector(1,-2){50}}
+%\put(200,300){\vector(6,-1){90}}
+\put(200,300){\vector(4,-1){90}}
+}
+
+\put(250,295){$\vec{r}_{1b}$}
+\put(195,270){$\vec{r}_{12}$}
+\put(175,225){$\vec{r}_{be}$}
+
+\put(170,310){$(\theta_1,\phi_1)$}
+\put(255,200){$(\theta_2,\phi_2)$}
+\put(300,285){$(\theta_b,\phi_b)$}
+\put( 10,125){$(\theta_e,\phi_e)$}
+
+\put(200,300){\circle*{4}}
+\put(250,200){\circle*{4}}
+\put(290,285){\circle*{4}}
+\put( 50,125){\circle*{4}}
+
+\put(225,225){Cell $k$}
+\put(250,100){Cell $n$}
+\put(200,150){$A_{kn}$}
+
+\end{picture}
+\end{figure}
+
+\section{Search algorithms}\label{sec:search}
+
+As mentioned in the previous section, the algorithm for
+computing the remapping weights is relatively simple.  The
+process amounts to finding the location of the endpoint
+of a segment and then finding the next intersection with
+the other grid.  The line integrals are then computed and
+summed according to which grid cells are associated with
+that particular subsegment.
+The most time-consuming portion of the algorithm
+is finding which cell on one grid
+contains an endpoint from the other grid.  Optimal
+search algorithms can be written when the grid is
+well structured and regular.  However, if one requires
+a search algorithm that will work for any general
+grid, a hierarchy of search algorithms appears to
+work best.  In SCRIP, each grid cell address is
+assigned to one or more latitude bins.  When the
+search begins, only those cells belonging to the
+same latitude bin as the search point are used.
+The second stage checks the bounding box of each
+grid cell in the latitude bin.  The bounding box
+is formed by the cells minimum and maximum latitude
+and longitude.  This process further restricts
+the search to a small number of cells.
+
+Once the search has been restricted, a robust algorithm
+that works for most cases is a cross-product test.
+In this test, a cross product is computed between
+the vector corresponding to a cell side ($\vec{r}_{12}$ in
+Figure~\ref{fig:grids}) and a vector extending from the
+beginning of the cell side to the search point ($\vec{r}_{1b}$).
+If
+\begin{equation}\label{eq:cross}
+\vec{r}_{12} \times \vec{r}_{1b} > 0,
+\end{equation}
+the point lies to the left of the cell side.  If
+(\ref{eq:cross}) holds for every cell side, the
+point is enclosed by the cell.
+This test is not completely robust and will fail for
+grid cells that are non-convex.
+
+\section{Intersections}\label{sec:intersect}
+
+Once the location of an initial endpoint is found,
+it is necessary to check to see if the segment intersects
+with the cell side.  If the segment is parametrized as
+\begin{eqnarray}
+\theta &=& \theta_b + s_1 (\theta_e - \theta_b) \nonumber \\
+\phi   &=& \phi_b + s_1 (\phi_e - \phi_b)
+\end{eqnarray}
+and the cell side as
+\begin{eqnarray}
+\theta &=& \theta_1 + s_2 (\theta_2 - \theta_1) \nonumber \\
+\phi   &=& \phi_1 + s_2 (\phi_2 - \phi_1),
+\end{eqnarray}
+where $\theta_1, \phi_1, \theta_2, \phi_2, \theta_b,$ and
+$\theta_e$ are endpoints as shown in Figure~\ref{fig:grids},
+the intersection of the two lines occurs when $\theta$
+and $\phi$ are equal.  The linear system
+\begin{equation}
+\left[ \begin{array}{cc}
+(\theta_e - \theta_b) & (\theta_1 - \theta_2) \\
+(\phi_e - \phi_b) & (\phi_1 - \phi_2) \\
+\end{array} \right]
+\left[ \begin{array}{c} s_1 \\ s_2 \\ \end{array} \right] =
+\left[ \begin{array}{c}
+(\theta_1 - \theta_b) \\ (\phi_1 - \phi_b)  \\
+\end{array} \right]
+\end{equation}
+is then solved
+to determine $s_1$ and $s_2$ at the intersection point.
+If $s_1$ and $s_2$ are between zero and one, an
+intersection occurs with that cell side.
+
+It is important also to compute identical intersections
+during the sweeps of each grid.  To ensure that this
+will occur, the entire line segment is used to
+compute intersections rather than using a previous or
+next intersection as an endpoint.
+
+\section{Coincidences}
+
+Often, pairs of grids will share common lines (e.g. the
+Equator).  When this is the case, the method described
+above will double-count the contribution of these line
+segments.  Coincidences can be detected when computing
+cross products for the search algorithm described above.
+If the cross product is zero
+in this case, the endpoint lies on the cell side.  A
+second cross product between the line segment and the
+cell side can then be computed.  If the second cross
+product is also zero, the lines are coincident.
+Once a coincidence has been detected, the contribution
+of the coincident segment can be computed during the
+first sweep and ignored during the second sweep.
+
+\section{Spherical coordinates}\label{sec-sphere}
+
+Some aspects of the spherical coordinate system introduce
+additional problems for the method described above.
+Longitude is multiple valued on one line on the sphere,
+and this branch cut may be chosen differently by different
+grids.  Care must be taken when calculating intersections
+and line integrals to ensure that the proper
+longitude values are used.  A simple method is to always
+check to make sure the longitude is in the same interval
+as the source grid cell center.
+
+Another problem with computing weights in spherical
+coordinates is the treatment of the pole.  First, note
+that although the pole is physically a point, it is a
+line in latitude-longitude space and has a nonzero
+contribution to the weight integrals.  If a grid does
+not contain the pole explicitly as a grid vertex, the
+pole contribution must be added to the appropriate cells.
+The pole contribution can be computed analytically.
+
+The pole also creates problems for the search and
+intersection algorithms described above.  For example,
+a grid cell that overlaps the pole can result in a
+nonconvex cell in latitude-longitude coordinates.
+The cross-product test described above
+will fail in this case.  In addition, segments near
+the pole typically exhibit large changes in longitude
+even for very short segments.  In such a case, the
+linear parametrizations used above
+result in inaccuracies for determining the correct
+intersections.
+
+To avoid these problems, a coordinate transformation
+can be used poleward of a given threshold latitude
+(typically within one degree of the pole).  A possible
+transformation is the Lambert equivalent azimuthal projection
+\begin{eqnarray}
+X &=& 2\sin\left({\pi \over 4} - {\theta \over 2}\right)\cos\phi \nonumber \\
+Y &=& 2\sin\left({\pi \over 4} - {\theta \over 2}\right)\sin\phi
+\end{eqnarray}
+for the North Pole.  The transformation for the South
+Pole is similar.  This transformation is only used to
+compute intersections; line integrals are still computed
+in latitude-longitude coordinates.  Because intersections
+computed in the transformed coordinates can be different
+from those computed in latitude-longitude coordinates,
+line segments which cross the latitude threshold must be
+treated carefully.  To compute the intersections
+consistently for such a segment, intersections with the
+threshold latitude are detected and used as a normal
+grid intersection to provide a clean break between the
+two coordinate systems.
+
+\section{Conclusion}
+
+The implementation in the SCRIP code follows closely
+the description above.  The user should be able to
+follow and understand the process based on this
+description.
+
+\chapter{Bilinear Remapping}
+
+Standard bilinear interpolation schemes can be found
+in many textbooks.  Here we present a more general
+scheme which uses a local bilinear approximation
+to interpolate to a point in a quadrilateral grid.
+Consider the grid points shown in Fig.~\ref{fig:quad}
+labelled with logically-rectangular indices (e.g. $(i,j)$).
+
+\begin{figure}
+\caption{A general quadrilateral grid. \label{fig:quad}}
+\begin{picture}(400,400)
+
+\put(40,40){\line(2,1){200}}
+\put(240,140){\line(1,2){100}}
+\put(40,40){\line(1,2){100}}
+\put(140,240){\line(2,1){200}}
+
+\put(40,40){\circle*{4}}
+\put(240,140){\circle*{4}}
+\put(140,240){\circle*{4}}
+\put(340,340){\circle*{4}}
+\put(210,200){\circle*{4}}
+
+\put(30 , 20){1 $(i,j)$}
+\put(250,130){2 $(i+1,j)$}
+\put( 80,240){$(i,j+1)$ 4}
+\put(350,340){3 $(i+1,j+1)$}
+\put(200,200){$P$}
+
+\end{picture}
+\end{figure}
+
+Let the latitude-longitude coordinates of point
+1 be $(\theta(i,j),\phi(i,j))$, the coordinates of
+point 2 be $(\theta(i+1,j),\phi(i+1,j))$, etc.
+Now let $\alpha$ and $\beta$ be continuous local
+coordinates such that the coordinates $(\alpha,\beta)$
+of point 1 are $(0,0)$, point 2 are $(1,0)$, point
+3 are $(1,1)$ and point 4 are $(0,1)$.  If point $P$
+lies inside the cell formed by the four points above,
+the function $f$ at point $P$ can be approximated by
+\begin{eqnarray}\label{eq:bilinear}
+f_P & = & (1-\alpha)(1-\beta)f(i,j) + \alpha(1-\beta)f(i+1,j) + \nonumber \\
+    &   & \alpha\beta f(i+1,j+1) + (1-\alpha)\beta f(i,j+1)  \\
+    & = & w_1 f(i,j) + w_2 f(i+1,j) + w_3 f(i+1,j+1) + w_4 f(i,j+1). \nonumber
+\end{eqnarray}
+The remapping weights must therefore be computed by
+finding $\alpha$ and $\beta$ at point $P$.
+
+The latitude-longitude coordinates $(\theta,\phi)$ of
+point $P$ are known and can also be approximated by
+\begin{eqnarray}\label{eq:thetaphi}
+\theta & = & (1-\alpha)(1-\beta)\theta_1 + \alpha(1-\beta)\theta_2 + \nonumber
+          \alpha\beta \theta_3 + (1-\alpha)\beta \theta_4 \\
+\phi   & = & (1-\alpha)(1-\beta)\phi_1   + \alpha(1-\beta)\phi_2 +
+          \alpha\beta \phi_3 + (1-\alpha)\beta \phi_4.
+\end{eqnarray}
+Because (\ref{eq:thetaphi}) is nonlinear in $\alpha$ and $\beta$,
+we must linearize and iterate toward a solution.  Differentiating
+(\ref{eq:thetaphi}) results in
+\begin{equation}
+\left[\begin{array}{c} \delta\theta \\ \delta\phi \end{array}\right]
+= A
+\left[\begin{array}{c} \delta\alpha \\ \delta\beta \end{array}\right],
+\end{equation}
+where
+\begin{equation}
+A = \left[\begin{array}{cc}
+(\theta_2-\theta_1) + (\theta_1-\theta_4+\theta_3-\theta_2)\beta &
+(\theta_4-\theta_1) + (\theta_1-\theta_4+\theta_3-\theta_2)\alpha \\
+(\phi_2-\phi_1) + (\phi_1-\phi_4+\phi_3-\phi_2)\beta &
+(\phi_4-\phi_1) + (\phi_1-\phi_4+\phi_3-\phi_2)\alpha
+\end{array}\right].
+\end{equation}
+Inverting this system,
+\begin{equation}\label{eq:dalpha}
+\delta\alpha = \left|\begin{array}{cc}
+\delta\theta &
+(\theta_4-\theta_1) + (\theta_1-\theta_4+\theta_3-\theta_2)\alpha \\
+\delta\phi &
+(\phi_4-\phi_1) + (\phi_1-\phi_4+\phi_3-\phi_2)\alpha
+\end{array}\right| \div \det(A),
+\end{equation}
+and
+\begin{equation}\label{eq:dbeta}
+\delta\beta
+= \left|\begin{array}{cc}
+(\theta_2-\theta_1) + (\theta_1-\theta_4+\theta_3-\theta_2)\beta &
+\delta\theta \\
+(\phi_2-\phi_1) + (\phi_1-\phi_4+\phi_3-\phi_2)\beta &
+\delta\phi
+\end{array}\right| \div \det(A).
+\end{equation}
+Starting with an initial guess for $\alpha$ and $\beta$
+(say $\alpha=\beta=0$), equations~(\ref{eq:dalpha}) and
+(\ref{eq:dbeta}) can be iterated until
+$\delta\alpha$ and $\delta\beta$ are suitably small.  The
+weights can then be computed from (\ref{eq:bilinear}).  Note
+that for simple latitude-longitude grids, this iteration
+will converge in the first iteration.
+
+In order to compute the weights using this general bilinear
+iteration, it must be determined in which box the point $P$
+resides.  For this, the search algorithms outlined in the
+previous chapter are used with the exception that instead
+of using cell corners, the relevant box is formed by
+neighbor cell centers as shown in Fig.~\ref{fig:quad}.
+
+\chapter{Bicubic Remapping}
+
+The bicubic remapping exactly follows the bilinear remapping
+except that four weights for each corner point are required.
+Thus, num\_wts is set to four for this option.
+The bicubic remapping is
+\begin{eqnarray}\label{eq:bicubic}
+f_P & = & 
+    (1 - \beta^2(3-2\beta))(1 - \alpha^2(3-2\alpha))f(i  ,j  ) + \nonumber \\
+& & (1 - \beta^2(3-2\beta))     \alpha^2(3-2\alpha) f(i+1,j  ) + \nonumber \\
+& &      \beta^2(3-2\beta)      \alpha^2(3-2\alpha) f(i+1,j+1) + \nonumber \\
+& &      \beta^2(3-2\beta) (1 - \alpha^2(3-2\alpha))f(i  ,j+1) + \nonumber \\
+& & (1 - \beta^2(3-2\beta))\alpha  (\alpha-1)^2
+                        {{\partial f}\over{\partial i}}(i  ,j  ) + \nonumber \\
+& & (1 - \beta^2(3-2\beta))\alpha^2(\alpha-1)
+                        {{\partial f}\over{\partial i}}(i+1,j  ) + \nonumber \\
+& &      \beta^2(3-2\beta) \alpha^2(\alpha-1)
+                        {{\partial f}\over{\partial i}}(i+1,j+1) + \nonumber \\
+& &      \beta^2(3-2\beta) \alpha  (\alpha-1)^2
+                        {{\partial f}\over{\partial i}}(i  ,j+1) + \nonumber \\
+& & \beta  (\beta-1)^2(1 - \alpha^2(3-2\alpha))
+                        {{\partial f}\over{\partial j}}(i  ,j  ) + \nonumber \\
+& & \beta  (\beta-1)^2     \alpha^2(3-2\alpha)
+                        {{\partial f}\over{\partial j}}(i+1,j  ) + \nonumber \\
+& & \beta^2(\beta-1)       \alpha^2(3-2\alpha)
+                        {{\partial f}\over{\partial j}}(i+1,j+1) + \nonumber \\
+& & \beta^2(\beta-1)  (1 - \alpha^2(3-2\alpha))
+                        {{\partial f}\over{\partial j}}(i  ,j+1) + \nonumber \\
+& & \alpha  (\alpha-1)^2\beta  (\beta-1)^2
+           {{\partial^2 f}\over{\partial i \partial j}}(i  ,j  ) + \nonumber \\
+& & \alpha^2(\alpha-1)  \beta  (\beta-1)^2
+           {{\partial^2 f}\over{\partial i \partial j}}(i+1,j  ) + \nonumber \\
+& & \alpha^2(\alpha-1)  \beta^2(\beta-1)
+           {{\partial^2 f}\over{\partial i \partial j}}(i+1,j+1) + \nonumber \\
+& & \alpha  (\alpha-1)^2\beta^2(\beta-1)
+           {{\partial^2 f}\over{\partial i \partial j}}(i  ,j+1)
+\end{eqnarray}
+where $\alpha$ and $\beta$ are identical to those found in
+the bilinear case and are found using an identical algorithm.
+Note that unlike the conservative remappings, the gradients
+here are gradients with respect to the {\em logical} variable
+and not latitude or longitude.  Lastly, the four weights
+corresponding to each address pair correspond to the
+weight multiplying the field value at the point, the weight
+multiplying the gradient with respect to $i$, the weight
+multiplying the gradient with respect to $j$, and the weight
+multiplying the cross gradient in that order.
+
+\chapter{Distance-weighted Average Remapping}
+
+This scheme for remapping is probably the simplest
+in this package.  The code simply searches for the
+num\_neighbors nearest neighbors and computes the
+weights using
+\begin{equation}\label{eq:distwgt}
+w = {{1/(d+\epsilon)} \over
+     {\sum_n^{\rm num\_neighbors} [1/(d_n+\epsilon)]}},
+\end{equation}
+where $\epsilon$ is a small number to prevent
+dividing by zero, the sum is for normalization and
+$d$ is the distance from the destination grid point
+to the source grid point.  The distance is the angular
+distance
+\begin{equation}\label{eq:distance}
+d = \cos^{-1}\left(\cos\theta_d\cos\theta_s
+                  (\cos\phi_d\cos\phi_s + \sin\phi_d\sin\phi_s) +
+                   \sin\theta_d\sin\theta_s\right),
+\end{equation}
+where $\theta$ is latitude, $\phi$ is longitude and the
+subscripts $d,s$ denote destination and source grids,
+respectively.
+
+When finding nearest neighbors, the distance is not
+computed between the destination grid point and every
+source grid point.  Instead, the search is narrowed by
+sorting the two grids into latitude bins.  Only those
+source grid cells lying in the same latitude bin as
+the destination grid cell are checked to find the
+nearest neighbors.
+
+\chapter{Bugs}
+
+A file called `bugs' is included in the distribution
+which lists current outstanding bugs as well as a
+version history.  Any further bugs, comments, or suggestions
+should be sent to me at pwjones@lanl.gov.
+
+The code does not have very useful error messages to
+help diagnose problems so feel free to pester me with
+any problems you encounter.
+
+The package has also not been extensively tested on
+a variety of machines.  It works fine on SGI machines
+and IBM machines, but has not been run on other machines.
+It is pretty vanilla Fortran, so should be ok on
+machines with standard-compliant F90 compilers.
+
+\end{document}
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/README
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/README	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/README	(revision 2352)
@@ -0,0 +1,17 @@
+
+      This directory contains some grid files in netCDF format
+      for use in the SCRIP remapping package.
+
+      In addition, there are several source codes for creating
+      netCDF files for use in SCRIP:
+
+      convertPOPT.f  - converts input grid files for the POP 
+                       ocean model to SCRIP netCDF format
+
+      convertgauss.f - creates a SCRIP netCDF grid file for
+                       a Gaussian lat/lon grid that a global
+                       spectral model would use
+
+      convert_old.f  - converts old grid files from a previous
+                       version of the SCRIP routines
+
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convertPOPT.f
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convertPOPT.f	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convertPOPT.f	(revision 2352)
@@ -0,0 +1,447 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This file converts a POP grid.dat file to a remapping grid file
+!     in netCDF format.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: convertPOPT.f,v 1.4 2001/08/21 21:22:56 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!***********************************************************************
+
+      program convertPOPT
+
+!-----------------------------------------------------------------------
+!
+!     This file converts a POP grid.dat file to a remapping grid file.
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod
+      use constants
+      use iounits
+      use netcdf_mod
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     variables that describe the grid
+!       4/3       nx = 192, ny = 128
+!       2/3 (mod) nx = 384, ny = 288
+!       x3p Greenland DP nx = 100, ny = 116
+!       x2p Greenland DP nx = 160, ny = 192
+!       x1p Greenland DP nx = 320, ny = 384
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter ::
+     &             nx = 320, ny = 384,
+     &             grid_size = nx*ny,
+     &             grid_rank = 2,
+     &             grid_corners = 4
+
+      integer (kind=int_kind), dimension(2) ::
+     &             grid_dims   ! size of each dimension
+
+      character(char_len), parameter :: 
+     &    grid_name = 'Greenland DP x1p',
+     &    grid_file_in  = '/scratch/pwjones/grid.320x384.da',
+     &    grid_topo_in  = '/scratch/pwjones/kmt.320x384.da',
+     &    grid_file_out = '/scratch/pwjones/Greenland_DP_x1p.nc'
+
+      real (kind=dbl_kind), parameter ::
+     &  radius    = 6370.0e5_dbl_kind       ! radius of Earth (cm)
+     &, area_norm = one/(radius*radius)
+
+!-----------------------------------------------------------------------
+!
+!     grid coordinates and masks
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(grid_size) ::
+     &             grid_imask
+
+      real (kind=dbl_kind), dimension(grid_size) ::
+     &             grid_area      ,  ! area as computed in POP
+     &             grid_center_lat,  ! lat/lon coordinates for
+     &             grid_center_lon   ! each grid center in radians
+
+      real (kind=dbl_kind), dimension(grid_corners,grid_size) ::
+     &             grid_corner_lat,  ! lat/lon coordinates for
+     &             grid_corner_lon   ! each grid corner in radians
+
+      real (kind=dbl_kind), dimension(nx,ny) ::
+     &             HTN, HTE          ! T-cell grid lengths
+
+!-----------------------------------------------------------------------
+!
+!     other local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: i, j, n, iunit, ocn_add, im1, jm1
+
+      integer (kind=int_kind) ::
+     &        ncstat,            ! general netCDF status variable
+     &        nc_grid_id,        ! netCDF grid dataset id
+     &        nc_gridsize_id,    ! netCDF grid size dim id
+     &        nc_gridcorn_id,    ! netCDF grid corner dim id
+     &        nc_gridrank_id,    ! netCDF grid rank dim id
+     &        nc_griddims_id,    ! netCDF grid dimensions id
+     &        nc_grdcntrlat_id,  ! netCDF grid center lat id
+     &        nc_grdcntrlon_id,  ! netCDF grid center lon id
+     &        nc_grdimask_id,    ! netCDF grid mask id
+     &        nc_gridarea_id,    ! netCDF grid area id
+     &        nc_grdcrnrlat_id,  ! netCDF grid corner lat id
+     &        nc_grdcrnrlon_id   ! netCDF grid corner lon id
+
+      integer (kind=int_kind), dimension(2) ::
+     &        nc_dims2_id        ! netCDF dim id array for 2-d arrays
+
+      real (kind=dbl_kind) :: tmplon, dxt, dyt
+
+!-----------------------------------------------------------------------
+!
+!     read in grid info
+!     lat/lon info is on velocity points which correspond
+!     to the NE corner (in logical space) of the grid cell.
+!
+!-----------------------------------------------------------------------
+
+      call get_unit(iunit)
+      open(unit=iunit, file=grid_topo_in, status='old', 
+     &     form='unformatted', access='direct', recl=grid_size*4)
+      read (unit=iunit,rec=1) grid_imask
+      call release_unit(iunit)
+
+      call get_unit(iunit)
+      open(unit=iunit, file=grid_file_in, status='old', 
+     &     form='unformatted', access='direct', recl=grid_size*8)
+      read (unit=iunit, rec=1) grid_corner_lat(3,:)
+      read (unit=iunit, rec=2) grid_corner_lon(3,:)
+      read (unit=iunit, rec=3) HTN
+      read (unit=iunit, rec=4) HTE
+      call release_unit(iunit)
+
+      grid_dims(1) = nx
+      grid_dims(2) = ny
+
+!-----------------------------------------------------------------------
+!
+!     convert KMT field to integer grid mask
+!
+!-----------------------------------------------------------------------
+
+      grid_imask = min(grid_imask, 1)
+
+!-----------------------------------------------------------------------
+!
+!     compute remaining corners
+!
+!-----------------------------------------------------------------------
+
+      do j=1,ny
+        do i=1,nx
+          ocn_add = (j-1)*nx + i
+          if (i .ne. 1) then
+            im1 = ocn_add - 1
+          else
+            im1 = ocn_add + nx - 1
+          endif
+
+          grid_corner_lat(4,ocn_add) = grid_corner_lat(3,im1)
+          grid_corner_lon(4,ocn_add) = grid_corner_lon(3,im1)
+        end do
+      end do
+
+      do j=2,ny
+        do i=1,nx
+          ocn_add = (j-1)*nx + i
+          jm1 = (j-2)*nx + i
+
+          grid_corner_lat(2,ocn_add) = grid_corner_lat(3,jm1)
+          grid_corner_lat(1,ocn_add) = grid_corner_lat(4,jm1)
+
+          grid_corner_lon(2,ocn_add) = grid_corner_lon(3,jm1)
+          grid_corner_lon(1,ocn_add) = grid_corner_lon(4,jm1)
+        end do
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     mock up the lower row boundaries
+!
+!-----------------------------------------------------------------------
+
+      do i=1,nx
+        grid_corner_lat(1,i) = -pih + tiny
+        grid_corner_lat(2,i) = -pih + tiny
+
+        grid_corner_lon(1,i) = grid_corner_lon(4,i)
+        grid_corner_lon(2,i) = grid_corner_lon(3,i)
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     correct for 0,2pi longitude crossings
+!
+!-----------------------------------------------------------------------
+
+      do ocn_add=1,grid_size
+        if (grid_corner_lon(1,ocn_add) > pi2) 
+     &      grid_corner_lon(1,ocn_add) = 
+     &      grid_corner_lon(1,ocn_add) - pi2
+        if (grid_corner_lon(1,ocn_add) < 0.0) 
+     &      grid_corner_lon(1,ocn_add) = 
+     &      grid_corner_lon(1,ocn_add) + pi2
+        do n=2,grid_corners
+          tmplon = grid_corner_lon(n  ,ocn_add) - 
+     &             grid_corner_lon(n-1,ocn_add) 
+          if (tmplon < -three*pih) grid_corner_lon(n,ocn_add) = 
+     &                             grid_corner_lon(n,ocn_add) + pi2
+          if (tmplon >  three*pih) grid_corner_lon(n,ocn_add) = 
+     &                             grid_corner_lon(n,ocn_add) - pi2
+        end do
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     compute ocean cell centers by averaging corner values
+!
+!-----------------------------------------------------------------------
+
+      do ocn_add=1,grid_size
+        grid_center_lat(ocn_add) = grid_corner_lat(1,ocn_add)
+        grid_center_lon(ocn_add) = grid_corner_lon(1,ocn_add)
+        do n=2,grid_corners
+          grid_center_lat(ocn_add) = grid_center_lat(ocn_add) + 
+     &                               grid_corner_lat(n,ocn_add)
+          grid_center_lon(ocn_add) = grid_center_lon(ocn_add) + 
+     &                               grid_corner_lon(n,ocn_add)
+        end do
+        grid_center_lat(ocn_add) = grid_center_lat(ocn_add)/
+     &                                  float(grid_corners)
+        grid_center_lon(ocn_add) = grid_center_lon(ocn_add)/
+     &                                  float(grid_corners)
+        if (grid_center_lon(ocn_add) > pi2) 
+     &      grid_center_lon(ocn_add) = grid_center_lon(ocn_add) - pi2
+        if (grid_center_lon(ocn_add) < 0.0) 
+     &      grid_center_lon(ocn_add) = grid_center_lon(ocn_add) + pi2
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     compute cell areas in same way as POP
+!
+!-----------------------------------------------------------------------
+
+      n = 0
+      do j=1,ny
+        if (j > 1) then
+          jm1 = j-1
+        else
+          jm1 = 1
+        endif
+        do i=1,nx
+          if (i > 1) then
+            im1 = i-1
+          else
+            im1 = nx
+          endif
+
+          n = n+1
+
+          dxt = half*(HTN(i,j) + HTN(i,jm1))
+          dyt = half*(HTE(i,j) + HTE(im1,j))
+          if (dxt == zero) dxt=one
+          if (dyt == zero) dyt=one
+
+          grid_area(n) = dxt*dyt*area_norm
+        end do
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     set up attributes for netCDF file
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** create netCDF dataset for this grid
+      !***
+
+      ncstat = nf_create (grid_file_out, NF_CLOBBER,
+     &                    nc_grid_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, NF_GLOBAL, 'title',
+     &                          len_trim(grid_name), grid_name)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid size dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_size', grid_size, 
+     &                     nc_gridsize_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid rank dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_rank', grid_rank, 
+     &                     nc_gridrank_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_corners', grid_corners, 
+     &                     nc_gridcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid dim size array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_dims', NF_INT,
+     &                     1, nc_gridrank_id, nc_griddims_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center latitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_center_lat', NF_DOUBLE,
+     &                     1, nc_gridsize_id, nc_grdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcntrlat_id, 'units',
+     &                          7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center longitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_center_lon', NF_DOUBLE,
+     &                     1, nc_gridsize_id, nc_grdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcntrlon_id, 'units',
+     &                          7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid area array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_area', NF_DOUBLE,
+     &                     1, nc_gridsize_id, nc_gridarea_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid mask
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_imask', NF_INT,
+     &                     1, nc_gridsize_id, nc_grdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdimask_id, 'units',
+     &                          8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner latitude array
+      !***
+
+      nc_dims2_id(1) = nc_gridcorn_id
+      nc_dims2_id(2) = nc_gridsize_id
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_corner_lat', NF_DOUBLE,
+     &                     2, nc_dims2_id, nc_grdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcrnrlat_id, 'units',
+     &                          7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner longitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_corner_lon', NF_DOUBLE,
+     &                     2, nc_dims2_id, nc_grdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcrnrlon_id, 'units',
+     &                          7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** end definition stage
+      !***
+
+      ncstat = nf_enddef(nc_grid_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     write grid data
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_put_var_int(nc_grid_id, nc_griddims_id, grid_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlat_id, 
+     &                           grid_center_lat)
+      ncstat = nf_put_var_int(nc_grid_id, nc_grdimask_id, grid_imask)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_gridarea_id, 
+     &                           grid_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlat_id, 
+     &                           grid_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlon_id, 
+     &                           grid_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcrnrlat_id, 
+     &                           grid_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcrnrlon_id, 
+     &                           grid_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_close(nc_grid_id)
+
+!***********************************************************************
+
+      end program convertPOPT
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convert_old.f
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convert_old.f	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convert_old.f	(revision 2352)
@@ -0,0 +1,287 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This file converts a POP grid.dat file to a remapping grid file
+!     in netCDF format.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: convert_old.f,v 1.2 2000/04/19 22:05:57 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!***********************************************************************
+
+      program convertPOPT
+
+!-----------------------------------------------------------------------
+!
+!     This file converts a POP grid.dat file to a remapping grid file.
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod
+      use constants
+      use iounits
+      use netcdf_mod
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     variables that describe the grid
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) ::
+     &             grid_size, grid_rank, grid_corners
+
+      integer (kind=int_kind), dimension(2) ::
+     &             grid_dims   ! size of each dimension
+
+      character(char_len) :: 
+     &             grid_name
+
+      character(char_len), parameter :: 
+     &             grid_file_in  = 'remap_grid_WWice.dat',
+     &             grid_file_out = 'remap_grid_WWice.nc'
+
+!-----------------------------------------------------------------------
+!
+!     grid coordinates and masks
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(:), allocatable ::
+     &             grid_imask
+
+      real (kind=dbl_kind), dimension(:), allocatable ::
+     &             grid_center_lat,  ! lat/lon coordinates for
+     &             grid_center_lon   ! each grid center in radians
+
+      real (kind=dbl_kind), dimension(:,:), allocatable ::
+     &             grid_corner_lat,  ! lat/lon coordinates for
+     &             grid_corner_lon   ! each grid corner in radians
+
+!-----------------------------------------------------------------------
+!
+!     other local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: i, j, n, iunit, ocn_add, im1, jm1
+
+      integer (kind=int_kind) ::
+     &        ncstat,            ! general netCDF status variable
+     &        nc_grid_id,        ! netCDF grid dataset id
+     &        nc_gridsize_id,    ! netCDF grid size dim id
+     &        nc_gridcorn_id,    ! netCDF grid corner dim id
+     &        nc_gridrank_id,    ! netCDF grid rank dim id
+     &        nc_griddims_id,    ! netCDF grid dimensions id
+     &        nc_grdcntrlat_id,  ! netCDF grid center lat id
+     &        nc_grdcntrlon_id,  ! netCDF grid center lon id
+     &        nc_grdimask_id,    ! netCDF grid mask id
+     &        nc_grdcrnrlat_id,  ! netCDF grid corner lat id
+     &        nc_grdcrnrlon_id   ! netCDF grid corner lon id
+
+      integer (kind=int_kind), dimension(2) ::
+     &        nc_dims2_id        ! netCDF dim id array for 2-d arrays
+
+      real (kind=dbl_kind) :: tmplon
+
+!-----------------------------------------------------------------------
+!
+!     read in grid info
+!     lat/lon info is on velocity points which correspond
+!     to the NE corner (in logical space) of the grid cell.
+!
+!-----------------------------------------------------------------------
+
+      call get_unit(iunit)
+      open(unit=iunit, file=grid_file_in, status='old', 
+     &     form='unformatted')
+
+      read(iunit) grid_name
+      read(iunit) grid_size, grid_corners, grid_rank, grid_dims
+
+      allocate( grid_center_lat(grid_size),
+     &		grid_center_lon(grid_size),
+     &		grid_imask     (grid_size),
+     &		grid_corner_lat(grid_corners, grid_size),
+     &		grid_corner_lon(grid_corners, grid_size) )
+
+      read(iunit) grid_center_lat
+      read(iunit) grid_center_lon
+      read(iunit) grid_corner_lat
+      read(iunit) grid_corner_lon
+      read(iunit) grid_imask
+      call release_unit(iunit)
+
+!-----------------------------------------------------------------------
+!
+!     set up attributes for netCDF file
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** create netCDF dataset for this grid
+      !***
+
+      ncstat = nf_create (grid_file_out, NF_CLOBBER,
+     &                    nc_grid_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, NF_GLOBAL, 'title',
+     &                          len_trim(grid_name), grid_name)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid size dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_size', grid_size, 
+     &                     nc_gridsize_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid rank dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_rank', grid_rank, 
+     &                     nc_gridrank_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_corners', grid_corners, 
+     &                     nc_gridcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid dim size array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_dims', NF_INT,
+     &                     1, nc_gridrank_id, nc_griddims_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center latitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_center_lat', NF_DOUBLE,
+     &                     1, nc_gridsize_id, nc_grdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcntrlat_id, 'units',
+     &                          7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center longitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_center_lon', NF_DOUBLE,
+     &                     1, nc_gridsize_id, nc_grdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcntrlon_id, 'units',
+     &                          7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid mask
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_imask', NF_INT,
+     &                     1, nc_gridsize_id, nc_grdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdimask_id, 'units',
+     &                          8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner latitude array
+      !***
+
+      nc_dims2_id(1) = nc_gridcorn_id
+      nc_dims2_id(2) = nc_gridsize_id
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_corner_lat', NF_DOUBLE,
+     &                     2, nc_dims2_id, nc_grdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcrnrlat_id, 'units',
+     &                          7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner longitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_corner_lon', NF_DOUBLE,
+     &                     2, nc_dims2_id, nc_grdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcrnrlon_id, 'units',
+     &                          7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** end definition stage
+      !***
+
+      ncstat = nf_enddef(nc_grid_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     write grid data
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_put_var_int(nc_grid_id, nc_griddims_id, grid_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlat_id, 
+     &                           grid_center_lat)
+      ncstat = nf_put_var_int(nc_grid_id, nc_grdimask_id, grid_imask)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlat_id, 
+     &                           grid_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlon_id, 
+     &                           grid_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcrnrlat_id, 
+     &                           grid_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcrnrlon_id, 
+     &                           grid_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_close(nc_grid_id)
+
+!***********************************************************************
+
+      end program convertPOPT
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convertgauss.f
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convertgauss.f	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convertgauss.f	(revision 2352)
@@ -0,0 +1,506 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This program creates a remapping grid file for Gaussian lat/lon
+!     grids (for spectral transform codes).
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: convertgauss.f,v 1.3 2000/04/19 22:05:57 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!***********************************************************************
+
+      program convert_gauss
+
+!-----------------------------------------------------------------------
+!
+!     This file creates a remapping grid file for a Gaussian grid
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod
+      use constants
+      use iounits
+      use netcdf_mod
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     variables that describe the grid
+!
+!     T42: nx=128 ny=64
+!     T62: nx=192 ny=94
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter ::
+     &             nx = 192, ny = 94,
+     &             grid_size = nx*ny,
+     &             grid_rank = 2,
+     &             grid_corners = 4
+
+      character(char_len), parameter :: 
+     &             grid_name = 'T62 Gaussian Grid',
+     &             grid_file_out = 'remap_grid_T62.nc'
+
+      integer (kind=int_kind), dimension(grid_rank) ::
+     &             grid_dims
+
+!-----------------------------------------------------------------------
+!
+!     grid coordinates and masks
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(grid_size) ::
+     &             grid_imask
+
+      real (kind=dbl_kind), dimension(grid_size) ::
+     &             grid_center_lat,  ! lat/lon coordinates for
+     &             grid_center_lon   ! each grid center in degrees
+
+      real (kind=dbl_kind), dimension(grid_corners,grid_size) ::
+     &             grid_corner_lat,  ! lat/lon coordinates for
+     &             grid_corner_lon   ! each grid corner in degrees
+
+!-----------------------------------------------------------------------
+!
+!     other local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: i, j, iunit, atm_add
+
+      integer (kind=int_kind) ::
+     &        ncstat,            ! general netCDF status variable
+     &        nc_grid_id,        ! netCDF grid dataset id
+     &        nc_gridsize_id,    ! netCDF grid size dim id
+     &        nc_gridcorn_id,    ! netCDF grid corner dim id
+     &        nc_gridrank_id,    ! netCDF grid rank dim id
+     &        nc_griddims_id,    ! netCDF grid dimension size id
+     &        nc_grdcntrlat_id,  ! netCDF grid center lat id
+     &        nc_grdcntrlon_id,  ! netCDF grid center lon id
+     &        nc_grdimask_id,    ! netCDF grid mask id
+     &        nc_grdcrnrlat_id,  ! netCDF grid corner lat id
+     &        nc_grdcrnrlon_id   ! netCDF grid corner lon id
+
+      integer (kind=int_kind), dimension(2) ::
+     &        nc_dims2_id        ! netCDF dim id array for 2-d arrays
+
+      real (kind=dbl_kind) :: dlon, minlon, maxlon, centerlon,
+     &                              minlat, maxlat, centerlat
+
+      real (kind=dbl_kind), dimension(ny) :: gauss_root, gauss_wgt
+
+!-----------------------------------------------------------------------
+!
+!     compute longitudes of cell centers and corners.  set up alon
+!     array for search routine.
+!
+!-----------------------------------------------------------------------
+
+      grid_dims(1) = nx
+      grid_dims(2) = ny
+
+      dlon = 360./nx
+
+      do i=1,nx
+
+        centerlon = (i-1)*dlon
+        minlon = centerlon - half*dlon
+        maxlon = centerlon + half*dlon
+
+        do j=1,ny
+          atm_add = (j-1)*nx + i
+
+          grid_center_lon(atm_add  ) = centerlon
+          grid_corner_lon(1,atm_add) = minlon
+          grid_corner_lon(2,atm_add) = maxlon
+          grid_corner_lon(3,atm_add) = maxlon
+          grid_corner_lon(4,atm_add) = minlon
+        end do
+
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     compute Gaussian latitudes and store in gauss_wgt.
+!
+!-----------------------------------------------------------------------
+
+      call gquad(ny, gauss_root, gauss_wgt)
+      do j=1,ny
+        gauss_wgt(j) = pih - gauss_root(ny+1-j)
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     compute latitudes at cell centers and corners.  set up alat 
+!     array for search routine.
+!
+!-----------------------------------------------------------------------
+
+      do j=1,ny
+        centerlat = gauss_wgt(j)
+
+        if (j .eq. 1) then
+          minlat = -pih
+        else
+          minlat = ATAN((COS(gauss_wgt(j-1)) - 
+     &                   COS(gauss_wgt(j  )))/
+     &                  (SIN(gauss_wgt(j  )) - 
+     &                   SIN(gauss_wgt(j-1))))
+        endif
+
+        if (j .eq. ny) then
+          maxlat = pih
+        else
+          maxlat = ATAN((COS(gauss_wgt(j  )) - 
+     &                   COS(gauss_wgt(j+1)))/
+     &                  (SIN(gauss_wgt(j+1)) - 
+     &                   SIN(gauss_wgt(j  ))))
+        endif
+
+        do i=1,nx
+          atm_add = (j-1)*nx + i
+          grid_center_lat(atm_add  ) = centerlat*360./pi2
+          grid_corner_lat(1,atm_add) = minlat*360./pi2
+          grid_corner_lat(2,atm_add) = minlat*360./pi2
+          grid_corner_lat(3,atm_add) = maxlat*360./pi2
+          grid_corner_lat(4,atm_add) = maxlat*360./pi2
+        end do
+
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     define mask
+!
+!-----------------------------------------------------------------------
+
+      grid_imask = 1
+
+!-----------------------------------------------------------------------
+!
+!     set up attributes for netCDF file
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** create netCDF dataset for this grid
+      !***
+
+      ncstat = nf_create (grid_file_out, NF_CLOBBER,
+     &                    nc_grid_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, NF_GLOBAL, 'title',
+     &                          len_trim(grid_name), grid_name)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid size dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_size', grid_size, 
+     &                     nc_gridsize_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_corners', grid_corners, 
+     &                     nc_gridcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid rank dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_rank', grid_rank, 
+     &                     nc_gridrank_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid dimension size array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_dims', NF_INT,
+     &                     1, nc_gridrank_id, nc_griddims_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center latitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_center_lat', NF_DOUBLE,
+     &                     1, nc_gridsize_id, nc_grdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcntrlat_id, 'units',
+     &                          7, 'degrees')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center longitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_center_lon', NF_DOUBLE,
+     &                     1, nc_gridsize_id, nc_grdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcntrlon_id, 'units',
+     &                          7, 'degrees')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid mask
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_imask', NF_INT,
+     &                     1, nc_gridsize_id, nc_grdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdimask_id, 'units',
+     &                          8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner latitude array
+      !***
+
+      nc_dims2_id(1) = nc_gridcorn_id
+      nc_dims2_id(2) = nc_gridsize_id
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_corner_lat', NF_DOUBLE,
+     &                     2, nc_dims2_id, nc_grdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcrnrlat_id, 'units',
+     &                          7, 'degrees')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner longitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_corner_lon', NF_DOUBLE,
+     &                     2, nc_dims2_id, nc_grdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcrnrlon_id, 'units',
+     &                          7, 'degrees')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** end definition stage
+      !***
+
+      ncstat = nf_enddef(nc_grid_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     write grid data
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_put_var_int(nc_grid_id, nc_griddims_id, grid_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_grid_id, nc_grdimask_id, grid_imask)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlat_id, 
+     &                           grid_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlon_id, 
+     &                           grid_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcrnrlat_id, 
+     &                           grid_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcrnrlon_id, 
+     &                           grid_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_close(nc_grid_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end program convert_gauss
+
+!***********************************************************************
+
+      subroutine gquad(l,root,w)
+
+!-----------------------------------------------------------------------
+!
+!     This subroutine finds the l roots (in theta) and gaussian weights 
+!     associated with the legendre polynomial of degree l > 1.
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod
+      use constants
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     intent(in)
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) :: l
+
+!-----------------------------------------------------------------------
+!
+!     intent(out)
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), dimension(l), intent(out) ::
+     &      root, w
+
+!-----------------------------------------------------------------------
+!
+!     local
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: l1, l2, l22, l3, k, i, j
+
+      real (kind=dbl_kind) :: 
+     &     del,co,p1,p2,p3,t1,t2,slope,s,c,pp1,pp2,p00
+
+!-----------------------------------------------------------------------
+!
+!     Define useful constants.
+!
+!-----------------------------------------------------------------------
+
+      del= pi/float(4*l)
+      l1 = l+1
+      co = float(2*l+3)/float(l1**2)
+      p2 = 1.0
+      t2 = -del
+      l2 = l/2
+      k = 1
+      p00 = one/sqrt(two)
+
+!-----------------------------------------------------------------------
+!
+!     Start search for each root by looking for crossing point.
+!
+!-----------------------------------------------------------------------
+
+      do i=1,l2
+   10    t1 = t2
+         t2 = t1+del
+         p1 = p2
+         s = sin(t2)
+         c = cos(t2)
+         pp1 = 1.0
+         p3 = p00
+         do j=1,l1
+            pp2 = pp1
+            pp1 = p3
+            p3 = 2.0*sqrt((float(j**2)-0.250)/float(j**2))*c*pp1-
+     &           sqrt(float((2*j+1)*(j-1)*(j-1))/
+     &           float((2*j-3)*j*j))*pp2
+         end do
+         p2 = pp1
+         if ((k*p2).gt.0) goto 10
+
+!-----------------------------------------------------------------------
+!
+!        Now converge using Newton-Raphson.
+!
+!-----------------------------------------------------------------------
+
+         k = -k
+   20    continue
+            slope = (t2-t1)/(p2-p1)
+            t1 = t2
+            t2 = t2-slope*p2
+            p1 = p2
+            s = sin(t2)
+            c = cos(t2)
+            pp1 = 1.0
+            p3 = p00
+            do j=1,l1
+               pp2 = pp1
+               pp1 = p3
+               p3 = 2.0*sqrt((float(j**2)-0.250)/float(j**2))*c*pp1-
+     &              sqrt(float((2*j+1)*(j-1)*(j-1))/
+     &              float((2*j-3)*j*j))*pp2
+            end do
+            p2 = pp1
+         if (abs(p2).gt.1.e-10) goto 20
+         root(i) = t2
+         w(i) = co*(sin(t2)/p3)**2
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     If l is odd, take care of odd point.
+!
+!-----------------------------------------------------------------------
+
+      l22 = 2*l2
+      if (l22 .ne. l) then
+         l2 = l2+1
+         t2 = pi/2.0
+         root(l2) = t2
+         s = sin(t2)
+         c = cos(t2)
+         pp1 = 1.0
+         p3 = p00
+         do j=1,l1
+            pp2 = pp1
+            pp1 = p3
+            p3 = 2.0*sqrt((float(j**2)-0.250)/float(j**2))*c*pp1-
+     &           sqrt(float((2*j+1)*(j-1)*(j-1))/
+     &           float((2*j-3)*j*j))*pp2
+         end do
+         p2 = pp1
+         w(l2) = co/p3**2
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     Use symmetry to compute remaining roots and weights.
+!
+!-----------------------------------------------------------------------
+
+      l3 = l2+1
+      do i=l3,l
+         root(i) = pi-root(l-i+1)
+         w(i) = w(l-i+1)
+      end do
+
+!-----------------------------------------------------------------------
+
+      end subroutine gquad
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/create_latlon.f
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/create_latlon.f	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/create_latlon.f	(revision 2352)
@@ -0,0 +1,305 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This program creates a remapping grid file for a lat/lon grid.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: create_latlon.f,v 1.1 2000/04/19 22:05:58 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!***********************************************************************
+
+      program create_latlon
+
+!-----------------------------------------------------------------------
+!
+!     This file creates a remapping grid file for a Gaussian grid
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod
+      use constants
+      use iounits
+      use netcdf_mod
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     variables that describe the grid
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter ::
+     &             nx = 360, ny = 180,
+     &             grid_size = nx*ny,
+     &             grid_rank = 2,
+     &             grid_corners = 4
+
+      character(char_len), parameter :: 
+     &             grid_name = 'Lat/lon 1 degree Grid',
+     &             grid_file_out = 'll1deg_grid.nc'
+
+      integer (kind=int_kind), dimension(grid_rank) ::
+     &             grid_dims
+
+!-----------------------------------------------------------------------
+!
+!     grid coordinates and masks
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(grid_size) ::
+     &             grid_imask
+
+      real (kind=dbl_kind), dimension(grid_size) ::
+     &             grid_center_lat,  ! lat/lon coordinates for
+     &             grid_center_lon   ! each grid center in degrees
+
+      real (kind=dbl_kind), dimension(grid_corners,grid_size) ::
+     &             grid_corner_lat,  ! lat/lon coordinates for
+     &             grid_corner_lon   ! each grid corner in degrees
+
+!-----------------------------------------------------------------------
+!
+!     other local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: i, j, iunit, atm_add
+
+      integer (kind=int_kind) ::
+     &        ncstat,            ! general netCDF status variable
+     &        nc_grid_id,        ! netCDF grid dataset id
+     &        nc_gridsize_id,    ! netCDF grid size dim id
+     &        nc_gridcorn_id,    ! netCDF grid corner dim id
+     &        nc_gridrank_id,    ! netCDF grid rank dim id
+     &        nc_griddims_id,    ! netCDF grid dimension size id
+     &        nc_grdcntrlat_id,  ! netCDF grid center lat id
+     &        nc_grdcntrlon_id,  ! netCDF grid center lon id
+     &        nc_grdimask_id,    ! netCDF grid mask id
+     &        nc_grdcrnrlat_id,  ! netCDF grid corner lat id
+     &        nc_grdcrnrlon_id   ! netCDF grid corner lon id
+
+      integer (kind=int_kind), dimension(2) ::
+     &        nc_dims2_id        ! netCDF dim id array for 2-d arrays
+
+      real (kind=dbl_kind) :: dlon, minlon, maxlon, centerlon,
+     &                        dlat, minlat, maxlat, centerlat
+
+!-----------------------------------------------------------------------
+!
+!     compute longitudes and latitudes of cell centers and corners.
+!
+!-----------------------------------------------------------------------
+
+      grid_dims(1) = nx
+      grid_dims(2) = ny
+
+      dlon = 360./nx
+      dlat = 180./ny
+
+      do j=1,ny
+
+        minlat = -90._dbl_kind + (j-1)*dlat
+        maxlat = -90._dbl_kind +  j   *dlat
+        centerlat = minlat + half*dlat
+
+        do i=1,nx
+          centerlon = (i-1)*dlon
+          minlon = centerlon - half*dlon
+          maxlon = centerlon + half*dlon
+
+          atm_add = (j-1)*nx + i
+
+          grid_center_lat(atm_add  ) = centerlat
+          grid_corner_lat(1,atm_add) = minlat
+          grid_corner_lat(2,atm_add) = minlat
+          grid_corner_lat(3,atm_add) = maxlat
+          grid_corner_lat(4,atm_add) = maxlat
+
+          grid_center_lon(atm_add  ) = centerlon
+          grid_corner_lon(1,atm_add) = minlon
+          grid_corner_lon(2,atm_add) = maxlon
+          grid_corner_lon(3,atm_add) = maxlon
+          grid_corner_lon(4,atm_add) = minlon
+        end do
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     define mask
+!
+!-----------------------------------------------------------------------
+
+      grid_imask = 1
+
+!-----------------------------------------------------------------------
+!
+!     set up attributes for netCDF file
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** create netCDF dataset for this grid
+      !***
+
+      ncstat = nf_create (grid_file_out, NF_CLOBBER,
+     &                    nc_grid_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, NF_GLOBAL, 'title',
+     &                          len_trim(grid_name), grid_name)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid size dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_size', grid_size, 
+     &                     nc_gridsize_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_corners', grid_corners, 
+     &                     nc_gridcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid rank dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_rank', grid_rank, 
+     &                     nc_gridrank_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid dimension size array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_dims', NF_INT,
+     &                     1, nc_gridrank_id, nc_griddims_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center latitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_center_lat', NF_DOUBLE,
+     &                     1, nc_gridsize_id, nc_grdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcntrlat_id, 'units',
+     &                          7, 'degrees')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center longitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_center_lon', NF_DOUBLE,
+     &                     1, nc_gridsize_id, nc_grdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcntrlon_id, 'units',
+     &                          7, 'degrees')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid mask
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_imask', NF_INT,
+     &                     1, nc_gridsize_id, nc_grdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdimask_id, 'units',
+     &                          8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner latitude array
+      !***
+
+      nc_dims2_id(1) = nc_gridcorn_id
+      nc_dims2_id(2) = nc_gridsize_id
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_corner_lat', NF_DOUBLE,
+     &                     2, nc_dims2_id, nc_grdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcrnrlat_id, 'units',
+     &                          7, 'degrees')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner longitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_corner_lon', NF_DOUBLE,
+     &                     2, nc_dims2_id, nc_grdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcrnrlon_id, 'units',
+     &                          7, 'degrees')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** end definition stage
+      !***
+
+      ncstat = nf_enddef(nc_grid_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     write grid data
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_put_var_int(nc_grid_id, nc_griddims_id, grid_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_grid_id, nc_grdimask_id, grid_imask)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlat_id, 
+     &                           grid_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlon_id, 
+     &                           grid_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcrnrlat_id, 
+     &                           grid_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcrnrlon_id, 
+     &                           grid_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_close(nc_grid_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end program create_latlon
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/makefile
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/makefile	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/makefile	(revision 2352)
@@ -0,0 +1,59 @@
+#
+# Makefile for interpolation code
+# CVS:$Id: makefile,v 1.3 2000/04/19 22:05:59 pwjones Exp $
+#
+#COMP = xlf
+COMP = f90
+FLAGS = -O3 -64 -r10000 -I/usr/local/include 
+#FLAGS = -g
+LIB  = -lnetcdf 
+INCL = 
+SRCDIR  = ../source
+EXEDIR  = .
+OBJ  = \
+	kinds_mod.o \
+	constants.o \
+	iounits.o \
+	netcdf.o
+
+all: convertPOPT convertgauss create_latlon
+
+convertold: $(OBJ) convert_old.o
+	$(COMP) $(FLAGS) $(OBJ) convert_old.o $(LIB) -o $(EXEDIR)/convertold
+
+convertPOPT: $(OBJ) convertPOPT.o
+	$(COMP) $(FLAGS) $(OBJ) convertPOPT.o $(LIB) -o $(EXEDIR)/convertPOPT
+
+convertgauss: $(OBJ) convertgauss.o
+	$(COMP) $(FLAGS) $(OBJ) convertgauss.o $(LIB) -o $(EXEDIR)/convertgauss
+
+create_latlon: $(OBJ) create_latlon.o
+	$(COMP) $(FLAGS) $(OBJ) create_latlon.o $(LIB) -o $(EXEDIR)/create_latlon
+
+kinds_mod.o: $(SRCDIR)/kinds_mod.f $(INCL)
+	$(COMP) $(FLAGS) -c $(SRCDIR)/kinds_mod.f
+
+constants.o: $(SRCDIR)/constants.f kinds_mod.o $(INCL)
+	$(COMP) $(FLAGS) -c $(SRCDIR)/constants.f
+
+iounits.o: $(SRCDIR)/iounits.f kinds_mod.o constants.o $(INCL)
+	$(COMP) $(FLAGS) -c $(SRCDIR)/iounits.f
+
+netcdf.o: $(SRCDIR)/netcdf.f kinds_mod.o constants.o $(INCL)
+	$(COMP) $(FLAGS) -c $(SRCDIR)/netcdf.f
+
+convert_old.o: convert_old.f kinds_mod.o constants.o iounits.o netcdf.o $(INCL)
+	$(COMP) $(FLAGS) -c convert_old.f
+
+convertPOPT.o: convertPOPT.f kinds_mod.o constants.o iounits.o netcdf.o $(INCL)
+	$(COMP) $(FLAGS) -c convertPOPT.f
+
+convertgauss.o: convertgauss.f kinds_mod.o constants.o iounits.o netcdf.o $(INCL)
+	$(COMP) $(FLAGS) -c convertgauss.f
+
+create_latlon.o: create_latlon.f kinds_mod.o constants.o iounits.o netcdf.o $(INCL)
+	$(COMP) $(FLAGS) -c create_latlon.f
+
+clean: 
+	/bin/rm *.o *.mod
+
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/scrip_in
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/scrip_in	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/scrip_in	(revision 2352)
@@ -0,0 +1,16 @@
+&remap_inputs
+    num_maps = 2
+    grid1_file = 'grids/remap_grid_POP43.nc'
+    grid2_file = 'grids/remap_grid_T42.nc'
+    interp_file1 = 'rmp_POP43_to_T42_conserv.nc'
+    interp_file2 = 'rmp_T42_to_POP43_conserv.nc'
+    map1_name = 'POP43 to T42 Conservative Mapping'
+    map2_name = 'T42 to POP43 Conservative Mapping'
+    map_method = 'conservative'
+    normalize_opt = 'frac'
+    output_opt = 'scrip'
+    restrict_type = 'latitude'
+    num_srch_bins = 90 
+    luse_grid1_area = .false.
+    luse_grid2_area = .false.
+/
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/scrip_test_in
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/scrip_test_in	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/scrip_test_in	(revision 2352)
@@ -0,0 +1,5 @@
+&remap_inputs
+    field_choice = 2
+    interp_file = 'rmp_T42_to_POP43_conserv.nc'
+    output_file = 'out_T42_to_POP43_conserv.nc'
+/
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/constants.f
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/constants.f	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/constants.f	(revision 2352)
@@ -0,0 +1,65 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module defines common constants used in many routines.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: constants.f,v 1.2 2000/04/19 21:56:25 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module constants
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod  ! defines common data types
+
+      implicit none
+
+      save
+
+!-----------------------------------------------------------------------
+
+      real (kind = dbl_kind), parameter :: 
+     &                        zero   = 0.0_dbl_kind,
+     &                        one    = 1.0_dbl_kind,
+     &                        two    = 2.0_dbl_kind,
+     &                        three  = 3.0_dbl_kind,
+     &                        four   = 4.0_dbl_kind,
+     &                        five   = 5.0_dbl_kind,
+     &                        half   = 0.5_dbl_kind,
+     &                        quart  = 0.25_dbl_kind,
+     &                        bignum = 1.e+20_dbl_kind,
+     &                        tiny   = 1.e-14_dbl_kind,
+     &                        pi     = 3.14159265359_dbl_kind,
+     &                        pi2    = two*pi,
+     &                        pih    = half*pi
+
+!-----------------------------------------------------------------------
+
+      end module constants
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/copyright
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/copyright	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/copyright	(revision 2352)
@@ -0,0 +1,26 @@
+!-----------------------------------------------------------------------
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!-----------------------------------------------------------------------
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/grids.f
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/grids.f	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/grids.f	(revision 2352)
@@ -0,0 +1,831 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module reads in and initializes two grids for remapping.
+!     NOTE: grid1 must be the master grid -- the grid that determines
+!           which cells participate (e.g. land mask) and the fractional
+!           area of grid2 cells that participate in the remapping.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: grids.f,v 1.6 2001/08/21 21:06:41 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module grids
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod    ! defines data types
+      use constants    ! common constants
+      use iounits      ! I/O unit manager
+      use netcdf_mod   ! netCDF stuff
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     variables that describe each grid
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), save ::
+     &             grid1_size, grid2_size, ! total points on each grid
+     &             grid1_rank, grid2_rank, ! rank of each grid
+     &             grid1_corners, grid2_corners ! number of corners
+                                                ! for each grid cell
+
+      integer (kind=int_kind), dimension(:), allocatable, save ::
+     &             grid1_dims, grid2_dims  ! size of each grid dimension
+
+      character(char_len), save :: 
+     &             grid1_name, grid2_name  ! name for each grid
+
+      character (char_len), save :: 
+     &             grid1_units, ! units for grid coords (degs/radians)
+     &             grid2_units  ! units for grid coords
+
+      real (kind=dbl_kind), parameter ::
+     &      deg2rad = pi/180.   ! conversion for deg to rads
+
+!-----------------------------------------------------------------------
+!
+!     grid coordinates and masks
+!
+!-----------------------------------------------------------------------
+
+      logical (kind=log_kind), dimension(:), allocatable, save ::
+     &             grid1_mask,        ! flag which cells participate
+     &             grid2_mask         ! flag which cells participate
+
+      real (kind=dbl_kind), dimension(:), allocatable, save ::
+     &             grid1_center_lat,  ! lat/lon coordinates for
+     &             grid1_center_lon,  ! each grid center in radians
+     &             grid2_center_lat, 
+     &             grid2_center_lon,
+     &             grid1_area,        ! tot area of each grid1 cell
+     &             grid2_area,        ! tot area of each grid2 cell
+     &             grid1_area_in,     ! area of grid1 cell from file
+     &             grid2_area_in,     ! area of grid2 cell from file
+     &             grid1_frac,        ! fractional area of grid cells
+     &             grid2_frac         ! participating in remapping
+
+      real (kind=dbl_kind), dimension(:,:), allocatable, save ::
+     &             grid1_corner_lat,  ! lat/lon coordinates for
+     &             grid1_corner_lon,  ! each grid corner in radians
+     &             grid2_corner_lat, 
+     &             grid2_corner_lon
+
+      logical (kind=log_kind), save ::
+     &             luse_grid_centers ! use centers for bounding boxes
+     &,            luse_grid1_area   ! use area from grid file
+     &,            luse_grid2_area   ! use area from grid file
+
+      real (kind=dbl_kind), dimension(:,:), allocatable, save ::
+     &             grid1_bound_box,  ! lat/lon bounding box for use
+     &             grid2_bound_box   ! in restricting grid searches
+
+!-----------------------------------------------------------------------
+!
+!     bins for restricting searches
+!
+!-----------------------------------------------------------------------
+
+      character (char_len), save ::
+     &        restrict_type  ! type of bins to use
+
+      integer (kind=int_kind), save ::
+     &        num_srch_bins  ! num of bins for restricted srch
+
+      integer (kind=int_kind), dimension(:,:), allocatable, save ::
+     &        bin_addr1, ! min,max adds for grid1 cells in this lat bin
+     &        bin_addr2  ! min,max adds for grid2 cells in this lat bin
+
+      real(kind=dbl_kind), dimension(:,:), allocatable, save ::
+     &        bin_lats   ! min,max latitude for each search bin
+     &,       bin_lons   ! min,max longitude for each search bin
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine grid_init(grid1_file, grid2_file)
+
+!-----------------------------------------------------------------------
+!
+!     this routine reads grid info from grid files and makes any
+!     necessary changes (e.g. for 0,2pi longitude range)
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(in) :: 
+     &             grid1_file, grid2_file  ! grid data files
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: 
+     &  n      ! loop counter
+     &, nele   ! element loop counter
+     &, iunit  ! unit number for opening files
+     &, i,j    ! logical 2d addresses
+     &, ip1,jp1
+     &, n_add, e_add, ne_add
+     &, nx, ny
+
+      integer (kind=int_kind) :: 
+     &         ncstat,           ! netCDF status variable
+     &         nc_grid1_id,       ! netCDF grid file id
+     &         nc_grid2_id,       ! netCDF grid file id
+     &         nc_grid1size_id,   ! netCDF grid size dim id
+     &         nc_grid2size_id,   ! netCDF grid size dim id
+     &         nc_grid1corn_id,   ! netCDF grid corner dim id
+     &         nc_grid2corn_id,   ! netCDF grid corner dim id
+     &         nc_grid1rank_id,   ! netCDF grid rank dim id
+     &         nc_grid2rank_id,   ! netCDF grid rank dim id
+     &         nc_grid1area_id,   ! netCDF grid rank dim id
+     &         nc_grid2area_id,   ! netCDF grid rank dim id
+     &         nc_grid1dims_id,   ! netCDF grid dimension size id
+     &         nc_grid2dims_id,   ! netCDF grid dimension size id
+     &         nc_grd1imask_id,   ! netCDF grid imask var id
+     &         nc_grd2imask_id,   ! netCDF grid imask var id
+     &         nc_grd1crnrlat_id, ! netCDF grid corner lat var id
+     &         nc_grd2crnrlat_id, ! netCDF grid corner lat var id
+     &         nc_grd1crnrlon_id, ! netCDF grid corner lon var id
+     &         nc_grd2crnrlon_id, ! netCDF grid corner lon var id
+     &         nc_grd1cntrlat_id, ! netCDF grid center lat var id
+     &         nc_grd2cntrlat_id, ! netCDF grid center lat var id
+     &         nc_grd1cntrlon_id, ! netCDF grid center lon var id
+     &         nc_grd2cntrlon_id  ! netCDF grid center lon var id
+
+      integer (kind=int_kind), dimension(:), allocatable :: 
+     &                            imask ! integer mask read from file
+
+      real (kind=dbl_kind) :: 
+     &  dlat,dlon           ! lat/lon intervals for search bins
+
+      real (kind=dbl_kind), dimension(4) ::
+     &  tmp_lats, tmp_lons  ! temps for computing bounding boxes
+
+!-----------------------------------------------------------------------
+!
+!     open grid files and read grid size/name data
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_open(grid1_file, NF_NOWRITE, nc_grid1_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_open(grid2_file, NF_NOWRITE, nc_grid2_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid1_id, 'grid_size', nc_grid1size_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid1_id, nc_grid1size_id, grid1_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid2_id, 'grid_size', nc_grid2size_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid2_id, nc_grid2size_id, grid2_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid1_id, 'grid_rank', nc_grid1rank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid1_id, nc_grid1rank_id, grid1_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid2_id, 'grid_rank', nc_grid2rank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid2_id, nc_grid2rank_id, grid2_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid1_id,'grid_corners',nc_grid1corn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid1_id,nc_grid1corn_id,grid1_corners)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid2_id,'grid_corners',nc_grid2corn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid2_id,nc_grid2corn_id,grid2_corners)
+      call netcdf_error_handler(ncstat)
+
+      allocate( grid1_dims(grid1_rank),
+     &          grid2_dims(grid2_rank))
+
+      ncstat = nf_get_att_text(nc_grid1_id, nf_global, 'title',
+     &                         grid1_name)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text(nc_grid2_id, nf_global, 'title',
+     &                         grid2_name)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     allocate grid coordinates/masks and read data
+!
+!-----------------------------------------------------------------------
+
+      allocate( grid1_mask      (grid1_size),
+     &          grid2_mask      (grid2_size),
+     &          grid1_center_lat(grid1_size), 
+     &          grid1_center_lon(grid1_size),
+     &          grid2_center_lat(grid2_size), 
+     &          grid2_center_lon(grid2_size),
+     &          grid1_area      (grid1_size),
+     &          grid2_area      (grid2_size),
+     &          grid1_frac      (grid1_size),
+     &          grid2_frac      (grid2_size),
+     &          grid1_corner_lat(grid1_corners, grid1_size),
+     &          grid1_corner_lon(grid1_corners, grid1_size),
+     &          grid2_corner_lat(grid2_corners, grid2_size),
+     &          grid2_corner_lon(grid2_corners, grid2_size),
+     &          grid1_bound_box (4            , grid1_size),
+     &          grid2_bound_box (4            , grid2_size))
+
+      allocate(imask(grid1_size))
+
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_dims', nc_grid1dims_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_imask', nc_grd1imask_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_center_lat', 
+     &                                   nc_grd1cntrlat_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_center_lon', 
+     &                                   nc_grd1cntrlon_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_corner_lat', 
+     &                                   nc_grd1crnrlat_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_corner_lon', 
+     &                                   nc_grd1crnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_grid1_id, nc_grid1dims_id, grid1_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_grid1_id, nc_grd1imask_id, imask)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid1_id, nc_grd1cntrlat_id, 
+     &                                       grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid1_id, nc_grd1cntrlon_id, 
+     &                                       grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid1_id, nc_grd1crnrlat_id, 
+     &                                       grid1_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid1_id, nc_grd1crnrlon_id, 
+     &                                       grid1_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (luse_grid1_area) then
+        allocate (grid1_area_in(grid1_size))
+        ncstat = nf_inq_varid(nc_grid1_id, 'grid_area', nc_grid1area_id)
+        call netcdf_error_handler(ncstat)
+        ncstat = nf_get_var_double(nc_grid1_id, nc_grid1area_id, 
+     &                                          grid1_area_in)
+        call netcdf_error_handler(ncstat)
+      endif
+
+      grid1_area = zero
+      grid1_frac = zero
+
+!-----------------------------------------------------------------------
+!
+!     initialize logical mask and convert lat/lon units if required
+!
+!-----------------------------------------------------------------------
+
+      where (imask == 1)
+        grid1_mask = .true.
+      elsewhere
+        grid1_mask = .false.
+      endwhere
+      deallocate(imask)
+
+      grid1_units = ' '
+      ncstat = nf_get_att_text(nc_grid1_id, nc_grd1cntrlat_id, 'units',
+     &                         grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+
+        grid1_center_lat = grid1_center_lat*deg2rad
+        grid1_center_lon = grid1_center_lon*deg2rad
+
+      case ('radians')
+
+        !*** no conversion necessary
+
+      case default
+
+        print *,'unknown units supplied for grid1 center lat/lon: '
+        print *,'proceeding assuming radians'
+
+      end select
+
+      grid1_units = ' '
+      ncstat = nf_get_att_text(nc_grid1_id, nc_grd1crnrlat_id, 'units',
+     &                         grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+
+        grid1_corner_lat = grid1_corner_lat*deg2rad
+        grid1_corner_lon = grid1_corner_lon*deg2rad
+
+      case ('radians')
+
+        !*** no conversion necessary
+
+      case default
+
+        print *,'unknown units supplied for grid1 corner lat/lon: '
+        print *,'proceeding assuming radians'
+
+      end select
+
+      ncstat = nf_close(nc_grid1_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     read data for grid 2
+!
+!-----------------------------------------------------------------------
+
+      allocate(imask(grid2_size))
+
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_dims', nc_grid2dims_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_imask', nc_grd2imask_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_center_lat', 
+     &                                   nc_grd2cntrlat_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_center_lon', 
+     &                                   nc_grd2cntrlon_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_corner_lat', 
+     &                                   nc_grd2crnrlat_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_corner_lon', 
+     &                                   nc_grd2crnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_grid2_id, nc_grid2dims_id, grid2_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_grid2_id, nc_grd2imask_id, imask)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid2_id, nc_grd2cntrlat_id, 
+     &                                       grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid2_id, nc_grd2cntrlon_id, 
+     &                                       grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid2_id, nc_grd2crnrlat_id, 
+     &                                       grid2_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid2_id, nc_grd2crnrlon_id, 
+     &                                       grid2_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (luse_grid2_area) then
+        allocate (grid2_area_in(grid2_size))
+        ncstat = nf_inq_varid(nc_grid2_id, 'grid_area', nc_grid2area_id)
+        call netcdf_error_handler(ncstat)
+        ncstat = nf_get_var_double(nc_grid2_id, nc_grid2area_id, 
+     &                                          grid2_area_in)
+        call netcdf_error_handler(ncstat)
+      endif
+
+      grid2_area = zero
+      grid2_frac = zero
+
+!-----------------------------------------------------------------------
+!
+!     initialize logical mask and convert lat/lon units if required
+!
+!-----------------------------------------------------------------------
+
+      where (imask == 1)
+        grid2_mask = .true.
+      elsewhere
+        grid2_mask = .false.
+      endwhere
+      deallocate(imask)
+
+      grid2_units = ' '
+      ncstat = nf_get_att_text(nc_grid2_id, nc_grd2cntrlat_id, 'units',
+     &                         grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+
+        grid2_center_lat = grid2_center_lat*deg2rad
+        grid2_center_lon = grid2_center_lon*deg2rad
+
+      case ('radians')
+
+        !*** no conversion necessary
+
+      case default
+
+        print *,'unknown units supplied for grid2 center lat/lon: '
+        print *,'proceeding assuming radians'
+
+      end select
+
+      grid2_units = ' '
+      ncstat = nf_get_att_text(nc_grid2_id, nc_grd2crnrlat_id, 'units',
+     &                         grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+
+        grid2_corner_lat = grid2_corner_lat*deg2rad
+        grid2_corner_lon = grid2_corner_lon*deg2rad
+
+      case ('radians')
+
+        !*** no conversion necessary
+
+      case default
+
+        print *,'no units supplied for grid2 corner lat/lon: '
+        print *,'proceeding assuming radians'
+
+      end select
+
+      ncstat = nf_close(nc_grid2_id)
+      call netcdf_error_handler(ncstat)
+
+
+!-----------------------------------------------------------------------
+!
+!     convert longitudes to 0,2pi interval
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_center_lon .gt. pi2)  grid1_center_lon =
+     &                                   grid1_center_lon - pi2
+      where (grid1_center_lon .lt. zero) grid1_center_lon =
+     &                                   grid1_center_lon + pi2
+      where (grid2_center_lon .gt. pi2)  grid2_center_lon =
+     &                                   grid2_center_lon - pi2
+      where (grid2_center_lon .lt. zero) grid2_center_lon =
+     &                                   grid2_center_lon + pi2
+      where (grid1_corner_lon .gt. pi2)  grid1_corner_lon =
+     &                                   grid1_corner_lon - pi2
+      where (grid1_corner_lon .lt. zero) grid1_corner_lon =
+     &                                   grid1_corner_lon + pi2
+      where (grid2_corner_lon .gt. pi2)  grid2_corner_lon =
+     &                                   grid2_corner_lon - pi2
+      where (grid2_corner_lon .lt. zero) grid2_corner_lon =
+     &                                   grid2_corner_lon + pi2
+
+!-----------------------------------------------------------------------
+!
+!     make sure input latitude range is within the machine values
+!     for +/- pi/2 
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_center_lat >  pih) grid1_center_lat =  pih
+      where (grid1_corner_lat >  pih) grid1_corner_lat =  pih
+      where (grid1_center_lat < -pih) grid1_center_lat = -pih
+      where (grid1_corner_lat < -pih) grid1_corner_lat = -pih
+
+      where (grid2_center_lat >  pih) grid2_center_lat =  pih
+      where (grid2_corner_lat >  pih) grid2_corner_lat =  pih
+      where (grid2_center_lat < -pih) grid2_center_lat = -pih
+      where (grid2_corner_lat < -pih) grid2_corner_lat = -pih
+
+!-----------------------------------------------------------------------
+!
+!     compute bounding boxes for restricting future grid searches
+!
+!-----------------------------------------------------------------------
+
+      if (.not. luse_grid_centers) then
+        grid1_bound_box(1,:) = minval(grid1_corner_lat, DIM=1)
+        grid1_bound_box(2,:) = maxval(grid1_corner_lat, DIM=1)
+        grid1_bound_box(3,:) = minval(grid1_corner_lon, DIM=1)
+        grid1_bound_box(4,:) = maxval(grid1_corner_lon, DIM=1)
+
+        grid2_bound_box(1,:) = minval(grid2_corner_lat, DIM=1)
+        grid2_bound_box(2,:) = maxval(grid2_corner_lat, DIM=1)
+        grid2_bound_box(3,:) = minval(grid2_corner_lon, DIM=1)
+        grid2_bound_box(4,:) = maxval(grid2_corner_lon, DIM=1)
+
+      else
+
+        nx = grid1_dims(1)
+        ny = grid1_dims(2)
+
+        do n=1,grid1_size
+
+          !*** find N,S and NE points to this grid point
+
+          j = (n - 1)/nx +1
+          i = n - (j-1)*nx
+
+          if (i < nx) then
+            ip1 = i + 1
+          else
+            !*** assume cyclic
+            ip1 = 1
+            !*** but if it is not, correct
+            e_add = (j - 1)*nx + ip1
+            if (abs(grid1_center_lat(e_add) - 
+     &              grid1_center_lat(n   )) > pih) then
+              ip1 = i
+            endif
+          endif
+
+          if (j < ny) then
+            jp1 = j+1
+          else
+            !*** assume cyclic
+            jp1 = 1
+            !*** but if it is not, correct
+            n_add = (jp1 - 1)*nx + i
+            if (abs(grid1_center_lat(n_add) - 
+     &              grid1_center_lat(n   )) > pih) then
+              jp1 = j
+            endif
+          endif
+
+          n_add = (jp1 - 1)*nx + i
+          e_add = (j - 1)*nx + ip1
+          ne_add = (jp1 - 1)*nx + ip1
+
+          !*** find N,S and NE lat/lon coords and check bounding box
+
+          tmp_lats(1) = grid1_center_lat(n)
+          tmp_lats(2) = grid1_center_lat(e_add)
+          tmp_lats(3) = grid1_center_lat(ne_add)
+          tmp_lats(4) = grid1_center_lat(n_add)
+
+          tmp_lons(1) = grid1_center_lon(n)
+          tmp_lons(2) = grid1_center_lon(e_add)
+          tmp_lons(3) = grid1_center_lon(ne_add)
+          tmp_lons(4) = grid1_center_lon(n_add)
+
+          grid1_bound_box(1,n) = minval(tmp_lats)
+          grid1_bound_box(2,n) = maxval(tmp_lats)
+          grid1_bound_box(3,n) = minval(tmp_lons)
+          grid1_bound_box(4,n) = maxval(tmp_lons)
+        end do
+
+        nx = grid2_dims(1)
+        ny = grid2_dims(2)
+
+        do n=1,grid2_size
+
+          !*** find N,S and NE points to this grid point
+
+          j = (n - 1)/nx +1
+          i = n - (j-1)*nx
+
+          if (i < nx) then
+            ip1 = i + 1
+          else
+            !*** assume cyclic
+            ip1 = 1
+            !*** but if it is not, correct
+            e_add = (j - 1)*nx + ip1
+            if (abs(grid2_center_lat(e_add) - 
+     &              grid2_center_lat(n   )) > pih) then
+              ip1 = i
+            endif
+          endif
+
+          if (j < ny) then
+            jp1 = j+1
+          else
+            !*** assume cyclic
+            jp1 = 1
+            !*** but if it is not, correct
+            n_add = (jp1 - 1)*nx + i
+            if (abs(grid2_center_lat(n_add) - 
+     &              grid2_center_lat(n   )) > pih) then
+              jp1 = j
+            endif
+          endif
+
+          n_add = (jp1 - 1)*nx + i
+          e_add = (j - 1)*nx + ip1
+          ne_add = (jp1 - 1)*nx + ip1
+
+          !*** find N,S and NE lat/lon coords and check bounding box
+
+          tmp_lats(1) = grid2_center_lat(n)
+          tmp_lats(2) = grid2_center_lat(e_add)
+          tmp_lats(3) = grid2_center_lat(ne_add)
+          tmp_lats(4) = grid2_center_lat(n_add)
+
+          tmp_lons(1) = grid2_center_lon(n)
+          tmp_lons(2) = grid2_center_lon(e_add)
+          tmp_lons(3) = grid2_center_lon(ne_add)
+          tmp_lons(4) = grid2_center_lon(n_add)
+
+          grid2_bound_box(1,n) = minval(tmp_lats)
+          grid2_bound_box(2,n) = maxval(tmp_lats)
+          grid2_bound_box(3,n) = minval(tmp_lons)
+          grid2_bound_box(4,n) = maxval(tmp_lons)
+        end do
+
+      endif
+
+      where (abs(grid1_bound_box(4,:) - grid1_bound_box(3,:)) > pi)
+        grid1_bound_box(3,:) = zero
+        grid1_bound_box(4,:) = pi2
+      end where
+
+      where (abs(grid2_bound_box(4,:) - grid2_bound_box(3,:)) > pi)
+        grid2_bound_box(3,:) = zero
+        grid2_bound_box(4,:) = pi2
+      end where
+
+      !***
+      !*** try to check for cells that overlap poles
+      !***
+
+      where (grid1_center_lat > grid1_bound_box(2,:))
+     &  grid1_bound_box(2,:) = pih
+
+      where (grid1_center_lat < grid1_bound_box(1,:))
+     &  grid1_bound_box(1,:) = -pih
+
+      where (grid2_center_lat > grid2_bound_box(2,:))
+     &  grid2_bound_box(2,:) = pih
+
+      where (grid2_center_lat < grid2_bound_box(1,:))
+     &  grid2_bound_box(1,:) = -pih
+
+!-----------------------------------------------------------------------
+!
+!     set up and assign address ranges to search bins in order to 
+!     further restrict later searches
+!
+!-----------------------------------------------------------------------
+
+      select case (restrict_type)
+
+      case ('latitude')
+        write(stdout,*) 'Using latitude bins to restrict search.'
+
+        allocate(bin_addr1(2,num_srch_bins))
+        allocate(bin_addr2(2,num_srch_bins))
+        allocate(bin_lats (2,num_srch_bins))
+        allocate(bin_lons (2,num_srch_bins))
+
+        dlat = pi/num_srch_bins
+
+        do n=1,num_srch_bins
+          bin_lats(1,n) = (n-1)*dlat - pih
+          bin_lats(2,n) =     n*dlat - pih
+          bin_lons(1,n) = zero
+          bin_lons(2,n) = pi2
+          bin_addr1(1,n) = grid1_size + 1
+          bin_addr1(2,n) = 0
+          bin_addr2(1,n) = grid2_size + 1
+          bin_addr2(2,n) = 0
+        end do
+
+        do nele=1,grid1_size
+          do n=1,num_srch_bins
+            if (grid1_bound_box(1,nele) <= bin_lats(2,n) .and.
+     &          grid1_bound_box(2,nele) >= bin_lats(1,n)) then
+              bin_addr1(1,n) = min(nele,bin_addr1(1,n))
+              bin_addr1(2,n) = max(nele,bin_addr1(2,n))
+            endif
+          end do
+        end do
+
+        do nele=1,grid2_size
+          do n=1,num_srch_bins
+            if (grid2_bound_box(1,nele) <= bin_lats(2,n) .and.
+     &          grid2_bound_box(2,nele) >= bin_lats(1,n)) then
+              bin_addr2(1,n) = min(nele,bin_addr2(1,n))
+              bin_addr2(2,n) = max(nele,bin_addr2(2,n))
+            endif
+          end do
+        end do
+
+      case ('latlon')
+        write(stdout,*) 'Using lat/lon boxes to restrict search.'
+
+        dlat = pi /num_srch_bins
+        dlon = pi2/num_srch_bins
+
+        allocate(bin_addr1(2,num_srch_bins*num_srch_bins))
+        allocate(bin_addr2(2,num_srch_bins*num_srch_bins))
+        allocate(bin_lats (2,num_srch_bins*num_srch_bins))
+        allocate(bin_lons (2,num_srch_bins*num_srch_bins))
+
+        n = 0
+        do j=1,num_srch_bins
+        do i=1,num_srch_bins
+          n = n + 1
+
+          bin_lats(1,n) = (j-1)*dlat - pih
+          bin_lats(2,n) =     j*dlat - pih
+          bin_lons(1,n) = (i-1)*dlon
+          bin_lons(2,n) =     i*dlon
+          bin_addr1(1,n) = grid1_size + 1
+          bin_addr1(2,n) = 0
+          bin_addr2(1,n) = grid2_size + 1
+          bin_addr2(2,n) = 0
+        end do
+        end do
+
+        num_srch_bins = num_srch_bins**2
+
+        do nele=1,grid1_size
+          do n=1,num_srch_bins
+            if (grid1_bound_box(1,nele) <= bin_lats(2,n) .and.
+     &          grid1_bound_box(2,nele) >= bin_lats(1,n) .and.
+     &          grid1_bound_box(3,nele) <= bin_lons(2,n) .and.
+     &          grid1_bound_box(4,nele) >= bin_lons(1,n)) then
+              bin_addr1(1,n) = min(nele,bin_addr1(1,n))
+              bin_addr1(2,n) = max(nele,bin_addr1(2,n))
+            endif
+          end do
+        end do
+
+        do nele=1,grid2_size
+          do n=1,num_srch_bins
+            if (grid2_bound_box(1,nele) <= bin_lats(2,n) .and.
+     &          grid2_bound_box(2,nele) >= bin_lats(1,n) .and.
+     &          grid2_bound_box(3,nele) <= bin_lons(2,n) .and.
+     &          grid2_bound_box(4,nele) >= bin_lons(1,n)) then
+              bin_addr2(1,n) = min(nele,bin_addr2(1,n))
+              bin_addr2(2,n) = max(nele,bin_addr2(2,n))
+            endif
+          end do
+        end do
+
+      case default
+        stop 'unknown search restriction method'
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine grid_init
+
+!***********************************************************************
+
+      end module grids
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/iounits.f
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/iounits.f	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/iounits.f	(revision 2352)
@@ -0,0 +1,154 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module is a dynamic I/O unit manager.  It keeps track of
+!     which units are in use and reserves units for stdin, stdout, and
+!     stderr.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: iounits.f,v 1.2 2000/04/19 21:56:25 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module iounits
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod   ! defines data types
+
+      implicit none
+
+!-----------------------------------------------------------------------
+
+      logical (kind=log_kind), dimension(99), save ::
+     &    unit_free   ! flags to determine whether unit is free for use
+
+      integer (kind=int_kind), parameter ::
+     &    stdin  = 5, ! reserves unit for standard input
+     &    stdout = 6, ! reserves unit for standard output
+     &    stderr = 6  ! reserves unit for standard error
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine get_unit(iunit)
+
+!-----------------------------------------------------------------------
+!
+!     This routine returns the next available I/O unit number.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(out) ::
+     &     iunit   ! next free I/O unit
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n
+
+      logical (kind=log_kind), save :: first_call = .true.
+
+!-----------------------------------------------------------------------
+!
+!     if this is the first call, reserve stdout, stdin and stderr
+!
+!-----------------------------------------------------------------------
+
+      if (first_call) then
+        unit_free = .true.
+        unit_free(stdin)  = .false.
+        unit_free(stdout) = .false.
+        unit_free(stderr) = .false.
+        first_call = .false.
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     search for next available unit
+!
+!-----------------------------------------------------------------------
+
+      srch_unit: do n=1,99
+        if (unit_free(n)) then
+          iunit = n
+          unit_free(n) = .false.
+          exit srch_unit
+        endif
+      end do srch_unit
+
+!-----------------------------------------------------------------------
+
+      end subroutine get_unit
+
+!***********************************************************************
+
+      subroutine release_unit(iunit)
+
+!-----------------------------------------------------------------------
+!
+!     This routine releases the specified unit and closes the file.
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::
+     &     iunit   ! I/O unit to release
+
+!-----------------------------------------------------------------------
+!
+!     closes I/O unit and declares it free
+!
+!-----------------------------------------------------------------------
+
+      unit_free(iunit) = .true.
+      close(iunit)
+
+!-----------------------------------------------------------------------
+
+      end subroutine release_unit
+
+!***********************************************************************
+
+      end module iounits
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/kinds_mod.f
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/kinds_mod.f	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/kinds_mod.f	(revision 2352)
@@ -0,0 +1,53 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module defines the F90 kind parameter for common data types.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: kinds_mod.f,v 1.2 2000/04/19 21:56:25 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module kinds_mod
+
+!-----------------------------------------------------------------------
+
+      implicit none
+      save
+
+!-----------------------------------------------------------------------
+
+      integer, parameter :: char_len  = 80,
+     &                      int_kind  = kind(1),
+     &                      log_kind  = kind(.true.),
+     &                      real_kind = selected_real_kind(6),
+     &                      dbl_kind  = selected_real_kind(13)
+
+!-----------------------------------------------------------------------
+
+      end module kinds_mod
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/makefile
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/makefile	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/makefile	(revision 2352)
@@ -0,0 +1,122 @@
+#!/bin/csh
+#
+# Makefile for interpolation code
+#
+# CVS:$Id: makefile,v 1.7 2000/04/19 21:46:44 pwjones Exp $
+#
+#COMPILE = xlf
+COMPILE = f90
+FLAGS = -O3 -r10000 -64 -I/usr/local/include
+#FLAGS = -g -DEBUG:div_check=3:subscript_check=ON:trap_uninitialized=ON:verbose_runtime=ON -r10000 -64 -I/usr/local/include 
+LIB  =  -lnetcdf 
+INCLUDE = 
+SRCDIR  = .
+EXEDIR  = ..
+OBJSET  = \
+	kinds_mod.o \
+	constants.o \
+	iounits.o \
+	netcdf.o \
+	grids.o \
+	remap_vars.o \
+	remap_distwgt.o \
+	remap_conserv.o \
+	remap_bilinear.o \
+	remap_bicubic.o \
+	timers.o \
+	remap_write.o \
+	scrip.o
+
+OBJTEST  = \
+	kinds_mod.o \
+	constants.o \
+	iounits.o \
+	netcdf.o \
+	grids.o \
+	timers.o \
+	remap_vars.o \
+	remap_read.o \
+	remap.o
+
+all: $(EXEDIR)/scrip $(EXEDIR)/scrip_test
+
+$(EXEDIR)/scrip: $(OBJSET)
+	$(COMPILE) $(FLAGS) $(OBJSET) $(LIB) -o $(EXEDIR)/scrip
+
+$(EXEDIR)/scrip_test: $(OBJTEST) scrip_test.o
+	$(COMPILE) $(FLAGS) $(OBJTEST) scrip_test.o $(LIB) \
+	-o $(EXEDIR)/scrip_test
+
+scrip_test_repeat: $(OBJTEST) scrip_test_repeat.o
+	$(COMPILE) $(FLAGS) $(OBJTEST) scrip_test_repeat.o $(LIB) \
+	-o $(EXEDIR)/scrip_test_repeat
+
+kinds_mod.o: $(SRCDIR)/kinds_mod.f $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/kinds_mod.f
+
+constants.o: $(SRCDIR)/constants.f kinds_mod.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/constants.f
+
+iounits.o: $(SRCDIR)/iounits.f kinds_mod.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/iounits.f
+
+netcdf.o: $(SRCDIR)/netcdf.f kinds_mod.o constants.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/netcdf.f
+
+grids.o: $(SRCDIR)/grids.f kinds_mod.o constants.o iounits.o netcdf.o \
+	$(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/grids.f
+
+remap_vars.o: $(SRCDIR)/remap_vars.f kinds_mod.o constants.o grids.o \
+	$(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/remap_vars.f
+
+remap_conserv.o: $(SRCDIR)/remap_conserv.f kinds_mod.o constants.o \
+		timers.o remap_vars.o grids.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/remap_conserv.f
+
+remap_distwgt.o: $(SRCDIR)/remap_distwgt.f kinds_mod.o constants.o \
+		remap_vars.o grids.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/remap_distwgt.f
+
+remap_bilinear.o: $(SRCDIR)/remap_bilinear.f kinds_mod.o constants.o \
+		remap_vars.o grids.o timers.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/remap_bilinear.f
+
+remap_bicubic.o: $(SRCDIR)/remap_bicubic.f kinds_mod.o constants.o \
+		remap_vars.o grids.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/remap_bicubic.f
+
+timers.o: $(SRCDIR)/timers.f kinds_mod.o constants.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/timers.f
+
+remap_write.o: $(SRCDIR)/remap_write.f kinds_mod.o constants.o \
+		netcdf.o remap_vars.o grids.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/remap_write.f
+
+remap_read.o: $(SRCDIR)/remap_read.f kinds_mod.o constants.o netcdf.o \
+		remap_vars.o grids.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/remap_read.f
+
+remap.o: $(SRCDIR)/remap.f kinds_mod.o constants.o 
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/remap.f
+
+scrip.o: $(SRCDIR)/scrip.f kinds_mod.o constants.o iounits.o timers.o \
+		remap_vars.o grids.o remap_conserv.o remap_distwgt.o \
+		remap_bilinear.o remap_bicubic.o remap_write.o \
+		$(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/scrip.f
+
+scrip_test.o: $(SRCDIR)/scrip_test.f kinds_mod.o constants.o iounits.o \
+		netcdf.o remap_vars.o grids.o remap.o remap_read.o \
+		$(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/scrip_test.f
+
+scrip_test_repeat.o: $(SRCDIR)/scrip_test_repeat.f kinds_mod.o \
+		constants.o netcdf.o \
+		iounits.o remap_vars.o grids.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/scrip_test_repeat.f
+
+clean: 
+	/bin/rm *.o *.mod
+
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/netcdf.f
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/netcdf.f	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/netcdf.f	(revision 2352)
@@ -0,0 +1,79 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module contains the netCDF include file and a netcdf error
+!     handling routine.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: netcdf.f,v 1.2 2000/04/19 21:56:25 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module netcdf_mod
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod
+      use constants
+
+      implicit none
+
+      include 'netcdf.inc'
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine netcdf_error_handler(istat)
+
+!-----------------------------------------------------------------------
+!
+!     This routine provides a simple interface to netCDF error message
+!     routine.
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) :: 
+     &    istat   ! integer status returned by netCDF function call
+
+!-----------------------------------------------------------------------
+
+      if (istat /= NF_NOERR) then
+        print *,'Error in netCDF: ',nf_strerror(istat)
+        stop
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine netcdf_error_handler
+
+!***********************************************************************
+
+      end module netcdf_mod
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap.f
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap.f	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap.f	(revision 2352)
@@ -0,0 +1,165 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this routine performs a remapping based on addresses and weights
+!     computed in a setup phase
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap.f,v 1.5 2000/04/19 21:56:25 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_mod
+
+!-----------------------------------------------------------------------
+!
+!     this module contains the routines for performing the actual
+!     remappings
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod    ! defines common data types
+      use constants    ! defines common constants
+
+      implicit none
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap(dst_array, map_wts, dst_add, src_add, 
+     &                 src_array, src_grad1, src_grad2, src_grad3)
+
+!-----------------------------------------------------------------------
+!
+!     performs the remapping based on weights computed elsewhere
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input arrays
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(:), intent(in) ::
+     &     dst_add,     ! destination address for each link
+     &     src_add      ! source      address for each link
+
+      real (kind=dbl_kind), dimension(:,:), intent(in) ::
+     &     map_wts      ! remapping weights for each link
+
+      real (kind=dbl_kind), dimension(:), intent(in) ::
+     &     src_array    ! array with source field to be remapped
+
+      real (kind=dbl_kind), dimension(:), intent(in), optional ::
+     &     src_grad1    ! gradient arrays on source grid necessary for
+     &,    src_grad2    ! higher-order remappings
+     &,    src_grad3
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), dimension(:), intent(inout) ::
+     &     dst_array    ! array for remapped field on destination grid
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, iorder
+
+!-----------------------------------------------------------------------
+!
+!     check the order of the interpolation
+!
+!-----------------------------------------------------------------------
+
+      if (present(src_grad1)) then
+        iorder = 2
+      else
+        iorder = 1
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     first order remapping
+!
+!-----------------------------------------------------------------------
+
+      dst_array = zero
+
+      select case (iorder)
+      case(1)
+
+        do n=1,size(dst_add)
+          dst_array(dst_add(n)) = dst_array(dst_add(n)) + 
+     &                            src_array(src_add(n))*map_wts(1,n)
+        end do
+
+!-----------------------------------------------------------------------
+!
+!     second order remapping
+!
+!-----------------------------------------------------------------------
+
+      case(2)
+
+        if (size(map_wts,DIM=1) == 3) then
+          do n=1,size(dst_add)
+            dst_array(dst_add(n)) = dst_array(dst_add(n)) +
+     &                              src_array(src_add(n))*map_wts(1,n) +
+     &                              src_grad1(src_add(n))*map_wts(2,n) +
+     &                              src_grad2(src_add(n))*map_wts(3,n)
+          end do
+        else if (size(map_wts,DIM=1) == 4) then
+          do n=1,size(dst_add)
+            dst_array(dst_add(n)) = dst_array(dst_add(n)) +
+     &                              src_array(src_add(n))*map_wts(1,n) +
+     &                              src_grad1(src_add(n))*map_wts(2,n) +
+     &                              src_grad2(src_add(n))*map_wts(3,n) +
+     &                              src_grad3(src_add(n))*map_wts(4,n)
+          end do
+        endif
+
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine remap
+
+!***********************************************************************
+
+      end module remap_mod
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_bicubic.f
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_bicubic.f	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_bicubic.f	(revision 2352)
@@ -0,0 +1,844 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary routines for performing an 
+!     bicubic interpolation.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_bicubic.f,v 1.5 2001/08/22 18:20:41 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_bicubic
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common constants
+      use grids         ! module containing grid info
+      use remap_vars    ! module containing remap info
+
+      implicit none
+
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter ::
+     &    max_iter = 100   ! max iteration count for i,j iteration
+
+      real (kind=dbl_kind), parameter ::
+     &     converge = 1.e-10_dbl_kind  ! convergence criterion
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap_bicub
+
+!-----------------------------------------------------------------------
+!
+!     this routine computes the weights for a bicubic interpolation.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n,icount,
+     &     dst_add,        ! destination address
+     &     iter,           ! iteration counter
+     &     nmap            ! index of current map being computed
+
+      integer (kind=int_kind), dimension(4) :: 
+     &     src_add         ! address for the four source points
+
+      real (kind=dbl_kind), dimension(4)  ::
+     &     src_lats,       ! latitudes  of four bilinear corners
+     &     src_lons        ! longitudes of four bilinear corners
+
+      real (kind=dbl_kind), dimension(4,4)  ::
+     &     wgts            ! bicubic weights for four corners
+
+      real (kind=dbl_kind) ::
+     &     plat, plon,       ! lat/lon coords of destination point
+     &     iguess, jguess,   ! current guess for bilinear coordinate
+     &     thguess, phguess, ! current guess for lat/lon coordinate
+     &     deli, delj,       ! corrections to i,j
+     &     dth1, dth2, dth3, ! some latitude  differences
+     &     dph1, dph2, dph3, ! some longitude differences
+     &     dthp, dphp,       ! difference between point and sw corner
+     &     mat1, mat2, mat3, mat4, ! matrix elements
+     &     determinant,      ! matrix determinant
+     &     sum_wgts,         ! sum of weights for normalization
+     &     w1,w2,w3,w4,w5,w6,w7,w8, ! 16 bicubic weight functions
+     &     w9,w10,w11,w12,w13,w14,w15,w16
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid1 to grid2
+!
+!-----------------------------------------------------------------------
+
+      nmap = 1
+      if (grid1_rank /= 2) then
+        stop 'Can not do bicubic interpolation when grid_rank /= 2'
+      endif
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop1: do dst_add = 1, grid2_size
+
+        if (.not. grid2_mask(dst_add)) cycle grid_loop1
+
+        plat = grid2_center_lat(dst_add)
+        plon = grid2_center_lon(dst_add)
+
+!-----------------------------------------------------------------------
+!
+!       find nearest square of grid points on source grid
+!
+!-----------------------------------------------------------------------
+
+        call grid_search_bicub(src_add, src_lats, src_lons, 
+     &                         plat, plon, grid1_dims,
+     &                         grid1_center_lat, grid1_center_lon,
+     &                         grid1_bound_box, bin_addr1, bin_addr2)
+
+        !***
+        !*** check to see if points are land points
+        !***
+
+        if (src_add(1) > 0) then
+          do n=1,4
+            if (.not. grid1_mask(src_add(n))) src_add(1) = 0
+          end do
+        endif
+
+!-----------------------------------------------------------------------
+!
+!       if point found, find local i,j coordinates for weights
+!
+!-----------------------------------------------------------------------
+
+        if (src_add(1) > 0) then
+
+          grid2_frac(dst_add) = one
+
+          !***
+          !*** iterate to find i,j for bicubic approximation
+          !***
+
+          dth1 = src_lats(2) - src_lats(1)
+          dth2 = src_lats(4) - src_lats(1)
+          dth3 = src_lats(3) - src_lats(2) - dth2
+
+          dph1 = src_lons(2) - src_lons(1)
+          dph2 = src_lons(4) - src_lons(1)
+          dph3 = src_lons(3) - src_lons(2)
+
+          if (dph1 >  three*pih) dph1 = dph1 - pi2
+          if (dph2 >  three*pih) dph2 = dph2 - pi2
+          if (dph3 >  three*pih) dph3 = dph3 - pi2
+          if (dph1 < -three*pih) dph1 = dph1 + pi2
+          if (dph2 < -three*pih) dph2 = dph2 + pi2
+          if (dph3 < -three*pih) dph3 = dph3 + pi2
+
+          dph3 = dph3 - dph2
+
+          iguess = half
+          jguess = half
+
+          iter_loop1: do iter=1,max_iter
+
+            dthp = plat - src_lats(1) - dth1*iguess -
+     &                    dth2*jguess - dth3*iguess*jguess
+            dphp = plon - src_lons(1)
+
+            if (dphp >  three*pih) dphp = dphp - pi2
+            if (dphp < -three*pih) dphp = dphp + pi2
+
+            dphp = dphp - dph1*iguess - dph2*jguess - 
+     &                    dph3*iguess*jguess
+
+            mat1 = dth1 + dth3*jguess
+            mat2 = dth2 + dth3*iguess
+            mat3 = dph1 + dph3*jguess
+            mat4 = dph2 + dph3*iguess
+
+            determinant = mat1*mat4 - mat2*mat3
+
+            deli = (dthp*mat4 - mat2*dphp)/determinant
+            delj = (mat1*dphp - dthp*mat3)/determinant
+
+            if (abs(deli) < converge .and. 
+     &          abs(delj) < converge) exit iter_loop1
+
+            iguess = iguess + deli
+            jguess = jguess + delj
+
+          end do iter_loop1
+
+          if (iter <= max_iter) then
+
+!-----------------------------------------------------------------------
+!
+!           successfully found i,j - compute weights
+!
+!-----------------------------------------------------------------------
+
+            wgts(1,1) = (one - jguess**2*(three-two*jguess))*
+     &                  (one - iguess**2*(three-two*iguess))
+            wgts(1,2) = (one - jguess**2*(three-two*jguess))*
+     &                         iguess**2*(three-two*iguess)
+            wgts(1,3) =        jguess**2*(three-two*jguess)*
+     &                         iguess**2*(three-two*iguess)
+            wgts(1,4) =        jguess**2*(three-two*jguess)*
+     &                  (one - iguess**2*(three-two*iguess))
+            wgts(2,1) = (one - jguess**2*(three-two*jguess))*
+     &                         iguess*(iguess-one)**2
+            wgts(2,2) = (one - jguess**2*(three-two*jguess))*
+     &                         iguess**2*(iguess-one)
+            wgts(2,3) =        jguess**2*(three-two*jguess)*
+     &                         iguess**2*(iguess-one)
+            wgts(2,4) =        jguess**2*(three-two*jguess)*
+     &                         iguess*(iguess-one)**2
+            wgts(3,1) =        jguess*(jguess-one)**2*
+     &                  (one - iguess**2*(three-two*iguess))
+            wgts(3,2) =        jguess*(jguess-one)**2*
+     &                         iguess**2*(three-two*iguess)
+            wgts(3,3) =        jguess**2*(jguess-one)*
+     &                         iguess**2*(three-two*iguess)
+            wgts(3,4) =        jguess**2*(jguess-one)*
+     &                  (one - iguess**2*(three-two*iguess))
+            wgts(4,1) =        iguess*(iguess-one)**2*
+     &                         jguess*(jguess-one)**2
+            wgts(4,2) =        iguess**2*(iguess-one)*
+     &                         jguess*(jguess-one)**2
+            wgts(4,3) =        iguess**2*(iguess-one)*
+     &                         jguess**2*(jguess-one)
+            wgts(4,4) =        iguess*(iguess-one)**2*
+     &                         jguess**2*(jguess-one)
+
+            call store_link_bicub(dst_add, src_add, wgts, nmap)
+
+          else
+            stop 'Iteration for i,j exceed max iteration count'
+          endif
+
+!-----------------------------------------------------------------------
+!
+!       search for bilinear failed - use a distance-weighted
+!       average instead (this is typically near the pole)
+!
+!-----------------------------------------------------------------------
+
+        else if (src_add(1) < 0) then
+
+          src_add = abs(src_add)
+
+          icount = 0
+          do n=1,4
+            if (grid1_mask(src_add(n))) then
+              icount = icount + 1
+            else
+              src_lats(n) = zero
+            endif
+          end do
+
+          if (icount > 0) then
+            !*** renormalize weights
+
+            sum_wgts = sum(src_lats)
+            wgts(1,1) = src_lats(1)/sum_wgts
+            wgts(1,2) = src_lats(2)/sum_wgts
+            wgts(1,3) = src_lats(3)/sum_wgts
+            wgts(1,4) = src_lats(4)/sum_wgts
+            wgts(2:4,:) = zero
+
+            grid2_frac(dst_add) = one
+            call store_link_bicub(dst_add, src_add, wgts, nmap)
+          endif
+
+        endif
+      end do grid_loop1
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid2 to grid1 if necessary
+!
+!-----------------------------------------------------------------------
+
+      if (num_maps > 1) then
+
+      nmap = 2
+      if (grid2_rank /= 2) then
+        stop 'Can not do bicubic interpolation when grid_rank /= 2'
+      endif
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop2: do dst_add = 1, grid1_size
+
+        if (.not. grid1_mask(dst_add)) cycle grid_loop2
+
+        plat = grid1_center_lat(dst_add)
+        plon = grid1_center_lon(dst_add)
+
+        !***
+        !*** find nearest square of grid points on source grid
+        !***
+
+        call grid_search_bicub(src_add, src_lats, src_lons, 
+     &                         plat, plon, grid2_dims,
+     &                         grid2_center_lat, grid2_center_lon,
+     &                         grid2_bound_box, bin_addr2, bin_addr1)
+
+        !***
+        !*** check to see if points are land points
+        !***
+
+        if (src_add(1) > 0) then
+          do n=1,4
+            if (.not. grid2_mask(src_add(n))) src_add(1) = 0
+          end do
+        endif
+
+        !***
+        !*** if point found, find i,j coordinates for weights
+        !***
+
+        if (src_add(1) > 0) then
+
+          grid1_frac(dst_add) = one
+
+          !***
+          !*** iterate to find i,j for bilinear approximation
+          !***
+
+          dth1 = src_lats(2) - src_lats(1)
+          dth2 = src_lats(4) - src_lats(1)
+          dth3 = src_lats(3) - src_lats(2) - dth2
+
+          dph1 = src_lons(2) - src_lons(1)
+          dph2 = src_lons(4) - src_lons(1)
+          dph3 = src_lons(3) - src_lons(2)
+
+          if (dph1 >  pi) dph1 = dph1 - pi2
+          if (dph2 >  pi) dph2 = dph2 - pi2
+          if (dph3 >  pi) dph3 = dph3 - pi2
+          if (dph1 < -pi) dph1 = dph1 + pi2
+          if (dph2 < -pi) dph2 = dph2 + pi2
+          if (dph3 < -pi) dph3 = dph3 + pi2
+
+          dph3 = dph3 - dph2
+
+          iguess = zero
+          jguess = zero
+
+          iter_loop2: do iter=1,max_iter
+
+            dthp = plat - src_lats(1) - dth1*iguess -
+     &                    dth2*jguess - dth3*iguess*jguess
+            dphp = plon - src_lons(1)
+
+            if (dphp >  pi) dphp = dphp - pi2
+            if (dphp < -pi) dphp = dphp + pi2
+
+            dphp = dphp - dph1*iguess - dph2*jguess - 
+     &                    dph3*iguess*jguess
+
+            mat1 = dth1 + dth3*jguess
+            mat2 = dth2 + dth3*iguess
+            mat3 = dph1 + dph3*jguess
+            mat4 = dph2 + dph3*iguess
+
+            determinant = mat1*mat4 - mat2*mat3
+
+            deli = (dthp*mat4 - mat2*dphp)/determinant
+            delj = (mat1*dphp - dthp*mat3)/determinant
+
+            if (abs(deli) < converge .and. 
+     &          abs(delj) < converge) exit iter_loop2
+
+            iguess = iguess + deli
+            jguess = jguess + delj
+
+          end do iter_loop2
+
+          if (iter <= max_iter) then
+
+            !***
+            !*** successfully found i,j - compute weights
+            !***
+
+            wgts(1,1) = (one - jguess**2*(three-two*jguess))*
+     &                  (one - iguess**2*(three-two*iguess))
+            wgts(1,2) = (one - jguess**2*(three-two*jguess))*
+     &                         iguess**2*(three-two*iguess)
+            wgts(1,3) =        jguess**2*(three-two*jguess)*
+     &                         iguess**2*(three-two*iguess)
+            wgts(1,4) =        jguess**2*(three-two*jguess)*
+     &                  (one - iguess**2*(three-two*iguess))
+            wgts(2,1) = (one - jguess**2*(three-two*jguess))*
+     &                         iguess*(iguess-one)**2
+            wgts(2,2) = (one - jguess**2*(three-two*jguess))*
+     &                         iguess**2*(iguess-one)
+            wgts(2,3) =        jguess**2*(three-two*jguess)*
+     &                         iguess**2*(iguess-one)
+            wgts(2,4) =        jguess**2*(three-two*jguess)*
+     &                         iguess*(iguess-one)**2
+            wgts(3,1) =        jguess*(jguess-one)**2*
+     &                  (one - iguess**2*(three-two*iguess))
+            wgts(3,2) =        jguess*(jguess-one)**2*
+     &                         iguess**2*(three-two*iguess)
+            wgts(3,3) =        jguess**2*(jguess-one)*
+     &                         iguess**2*(three-two*iguess)
+            wgts(3,4) =        jguess**2*(jguess-one)*
+     &                  (one - iguess**2*(three-two*iguess))
+            wgts(4,1) =        iguess*(iguess-one)**2*
+     &                         jguess*(jguess-one)**2
+            wgts(4,2) =        iguess**2*(iguess-one)*
+     &                         jguess*(jguess-one)**2
+            wgts(4,3) =        iguess**2*(iguess-one)*
+     &                         jguess**2*(jguess-one)
+            wgts(4,4) =        iguess*(iguess-one)**2*
+     &                         jguess**2*(jguess-one)
+
+            call store_link_bicub(dst_add, src_add, wgts, nmap)
+
+          else
+            stop 'Iteration for i,j exceed max iteration count'
+          endif
+
+        !***
+        !*** search for bilinear failed - us a distance-weighted
+        !*** average instead
+        !***
+
+        else if (src_add(1) < 0) then
+
+          src_add = abs(src_add)
+
+          icount = 0
+          do n=1,4
+            if (grid2_mask(src_add(n))) then
+              icount = icount + 1
+            else
+              src_lats(n) = zero
+            endif
+          end do
+
+          if (icount > 0) then
+            !*** renormalize weights
+
+            sum_wgts = sum(src_lats)
+            wgts(1,1) = src_lats(1)/sum_wgts
+            wgts(1,2) = src_lats(2)/sum_wgts
+            wgts(1,3) = src_lats(3)/sum_wgts
+            wgts(1,4) = src_lats(4)/sum_wgts
+            wgts(2:4,:) = zero
+
+            grid1_frac(dst_add) = one
+            call store_link_bicub(dst_add, src_add, wgts, nmap)
+          endif
+
+        endif
+      end do grid_loop2
+
+      endif ! nmap=2
+
+!-----------------------------------------------------------------------
+
+      end subroutine remap_bicub
+
+!***********************************************************************
+
+      subroutine grid_search_bicub(src_add, src_lats, src_lons, 
+     &                             plat, plon, src_grid_dims,
+     &                             src_center_lat, src_center_lon,
+     &                             src_bound_box,
+     &                             src_bin_add, dst_bin_add)
+
+!-----------------------------------------------------------------------
+!
+!     this routine finds the location of the search point plat, plon
+!     in the source grid and returns the corners needed for a bicubic
+!     interpolation.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(4), intent(out) ::
+     &        src_add  ! address of each corner point enclosing P
+
+      real (kind=dbl_kind), dimension(4), intent(out) ::
+     &        src_lats, ! latitudes  of the four corner points
+     &        src_lons  ! longitudes of the four corner points
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), intent(in) ::
+     &        plat,   ! latitude  of the search point
+     &        plon    ! longitude of the search point
+
+      integer (kind=int_kind), dimension(2), intent(in) ::
+     &        src_grid_dims  ! size of each src grid dimension
+
+      real (kind=dbl_kind), dimension(:), intent(in) ::
+     &        src_center_lat, ! latitude  of each src grid center 
+     &        src_center_lon  ! longitude of each src grid center
+
+      real (kind=dbl_kind), dimension(:,:), intent(in) ::
+     &        src_bound_box   ! bounding box for src grid search
+
+      integer (kind=int_kind), dimension(:,:), intent(in) ::
+     &        src_bin_add,    ! search bins for restricting
+     &        dst_bin_add     ! searches
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, next_n, srch_add,   ! dummy indices
+     &    nx, ny,            ! dimensions of src grid
+     &    min_add, max_add,  ! addresses for restricting search
+     &    i, j, jp1, ip1, n_add, e_add, ne_add  ! addresses
+
+      real (kind=dbl_kind) ::  ! vectors for cross-product check
+     &      vec1_lat, vec1_lon,
+     &      vec2_lat, vec2_lon, cross_product, cross_product_last,
+     &      coslat_dst, sinlat_dst, coslon_dst, sinlon_dst,
+     &      dist_min, distance ! for computing dist-weighted avg
+
+!-----------------------------------------------------------------------
+!
+!     restrict search first using search bins. 
+!
+!-----------------------------------------------------------------------
+
+      src_add = 0
+
+      min_add = size(src_center_lat)
+      max_add = 1
+      do n=1,num_srch_bins
+        if (plat >= bin_lats(1,n) .and. plat <= bin_lats(2,n) .and.
+     &      plon >= bin_lons(1,n) .and. plon <= bin_lons(2,n)) then
+          min_add = min(min_add, src_bin_add(1,n))
+          max_add = max(max_add, src_bin_add(2,n))
+        endif
+      end do
+ 
+!-----------------------------------------------------------------------
+!
+!     now perform a more detailed search 
+!
+!-----------------------------------------------------------------------
+
+      nx = src_grid_dims(1)
+      ny = src_grid_dims(2)
+
+      srch_loop: do srch_add = min_add,max_add
+
+        if (plat <= src_bound_box(2,srch_add) .and. 
+     &      plat >= src_bound_box(1,srch_add) .and.
+     &      plon <= src_bound_box(4,srch_add) .and. 
+     &      plon >= src_bound_box(3,srch_add)) then
+
+          !***
+          !*** we are within bounding box so get really serious
+          !***
+
+          !*** find N,S and NE points to this grid point
+
+          j = (srch_add - 1)/nx +1
+          i = srch_add - (j-1)*nx
+
+          if (i < nx) then
+            ip1 = i + 1
+          else
+            ip1 = 1
+          endif
+
+          if (j < ny) then
+            jp1 = j+1
+          else
+            jp1 = 1
+          endif
+
+          n_add = (jp1 - 1)*nx + i
+          e_add = (j - 1)*nx + ip1
+          ne_add = (jp1 - 1)*nx + ip1
+
+          !***
+          !*** find N,S and NE lat/lon coords and check bounding box
+          !***
+
+          src_lats(1) = src_center_lat(srch_add)
+          src_lats(2) = src_center_lat(e_add)
+          src_lats(3) = src_center_lat(ne_add)
+          src_lats(4) = src_center_lat(n_add)
+
+          src_lons(1) = src_center_lon(srch_add)
+          src_lons(2) = src_center_lon(e_add)
+          src_lons(3) = src_center_lon(ne_add)
+          src_lons(4) = src_center_lon(n_add)
+
+          !***
+          !*** for consistency, we must make sure all lons are in
+          !*** same 2pi interval
+          !***
+
+          vec1_lon = src_lons(1) - plon
+          if (vec1_lon > pi) then
+            src_lons(1) = src_lons(1) - pi2
+          else if (vec1_lon < -pi) then
+            src_lons(1) = src_lons(1) + pi2
+          endif
+          do n=2,4
+            vec1_lon = src_lons(n) - src_lons(1)
+            if (vec1_lon > pi) then
+              src_lons(n) = src_lons(n) - pi2
+            else if (vec1_lon < -pi) then
+              src_lons(n) = src_lons(n) + pi2
+            endif
+          end do
+
+          corner_loop: do n=1,4
+            next_n = MOD(n,4) + 1
+
+            !***
+            !*** here we take the cross product of the vector making 
+            !*** up each box side with the vector formed by the vertex
+            !*** and search point.  if all the cross products are 
+            !*** same sign, the point is contained in the box.
+            !***
+
+            vec1_lat = src_lats(next_n) - src_lats(n)
+            vec1_lon = src_lons(next_n) - src_lons(n)
+            vec2_lat = plat - src_lats(n)
+            vec2_lon = plon - src_lons(n)
+
+            !***
+            !*** check for 0,2pi crossings
+            !***
+
+            if (vec1_lon >  three*pih) then
+              vec1_lon = vec1_lon - pi2
+            else if (vec1_lon < -three*pih) then
+              vec1_lon = vec1_lon + pi2
+            endif
+            if (vec2_lon >  three*pih) then
+              vec2_lon = vec2_lon - pi2
+            else if (vec2_lon < -three*pih) then
+              vec2_lon = vec2_lon + pi2
+            endif
+
+            cross_product = vec1_lon*vec2_lat - vec2_lon*vec1_lat
+
+            !***
+            !*** if cross product is less than zero, this cell
+            !*** doesn't work
+            !***
+
+            if (n==1) cross_product_last = cross_product
+            if (cross_product*cross_product_last < zero) then
+              exit corner_loop
+            else
+              cross_product_last = cross_product
+            endif
+
+          end do corner_loop
+
+          !***
+          !*** if cross products all positive, we found the location
+          !***
+
+          if (n > 4) then
+            src_add(1) = srch_add
+            src_add(2) = e_add
+            src_add(3) = ne_add
+            src_add(4) = n_add
+
+            return
+          endif
+
+          !***
+          !*** otherwise move on to next cell
+          !***
+
+        endif !bounding box check
+      end do srch_loop
+
+      !***
+      !*** if no cell found, point is likely either in a box that
+      !*** straddles either pole or is outside the grid.  fall back
+      !*** to a distance-weighted average of the four closest
+      !*** points.  go ahead and compute weights here, but store
+      !*** in src_lats and return -add to prevent the parent
+      !*** routine from computing bilinear weights
+      !***
+
+      coslat_dst = cos(plat)
+      sinlat_dst = sin(plat)
+      coslon_dst = cos(plon)
+      sinlon_dst = sin(plon)
+
+      dist_min = bignum
+      src_lats = bignum
+      do srch_add = min_add,max_add
+        distance = acos(coslat_dst*cos(src_center_lat(srch_add))*
+     &                 (coslon_dst*cos(src_center_lon(srch_add)) +
+     &                  sinlon_dst*sin(src_center_lon(srch_add)))+
+     &                  sinlat_dst*sin(src_center_lat(srch_add)))
+
+        if (distance < dist_min) then
+          sort_loop: do n=1,4
+            if (distance < src_lats(n)) then
+              do i=4,n+1,-1
+                src_add (i) = src_add (i-1)
+                src_lats(i) = src_lats(i-1)
+              end do
+              src_add (n) = -srch_add
+              src_lats(n) = distance
+              dist_min = src_lats(4)
+              exit sort_loop
+            endif
+          end do sort_loop
+        endif
+      end do
+
+      src_lons = one/(src_lats + tiny)
+      distance = sum(src_lons)
+      src_lats = src_lons/distance
+
+!-----------------------------------------------------------------------
+
+      end subroutine grid_search_bicub 
+
+!***********************************************************************
+
+      subroutine store_link_bicub(dst_add, src_add, weights, nmap)
+
+!-----------------------------------------------------------------------
+!
+!     this routine stores the address and weight for four links 
+!     associated with one destination point in the appropriate address 
+!     and weight arrays and resizes those arrays if necessary.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::
+     &        dst_add,  ! address on destination grid
+     &        nmap      ! identifies which direction for mapping
+
+      integer (kind=int_kind), dimension(4), intent(in) ::
+     &        src_add   ! addresses on source grid
+
+      real (kind=dbl_kind), dimension(4,4), intent(in) ::
+     &        weights ! array of remapping weights for these links
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, ! dummy index
+     &       num_links_old          ! placeholder for old link number
+
+!-----------------------------------------------------------------------
+!
+!     increment number of links and check to see if remap arrays need
+!     to be increased to accomodate the new link.  then store the
+!     link.
+!
+!-----------------------------------------------------------------------
+
+      select case (nmap)
+      case(1)
+
+        num_links_old  = num_links_map1
+        num_links_map1 = num_links_old + 4
+
+        if (num_links_map1 > max_links_map1) 
+     &     call resize_remap_vars(1,resize_increment)
+
+        do n=1,4
+          grid1_add_map1(num_links_old+n) = src_add(n)
+          grid2_add_map1(num_links_old+n) = dst_add
+          wts_map1    (:,num_links_old+n) = weights(:,n)
+        end do
+
+      case(2)
+
+        num_links_old  = num_links_map2
+        num_links_map2 = num_links_old + 4
+
+        if (num_links_map2 > max_links_map2) 
+     &     call resize_remap_vars(2,resize_increment)
+
+        do n=1,4
+          grid1_add_map2(num_links_old+n) = dst_add
+          grid2_add_map2(num_links_old+n) = src_add(n)
+          wts_map2    (:,num_links_old+n) = weights(:,n)
+        end do
+
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine store_link_bicub
+
+!***********************************************************************
+
+      end module remap_bicubic
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_bilinear.f
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_bilinear.f	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_bilinear.f	(revision 2352)
@@ -0,0 +1,781 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary routines for performing an 
+!     bilinear interpolation.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_bilinear.f,v 1.6 2001/08/22 18:20:40 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_bilinear
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common constants
+      use grids         ! module containing grid info
+      use remap_vars    ! module containing remap info
+
+      implicit none
+
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter ::
+     &    max_iter = 100   ! max iteration count for i,j iteration
+
+      real (kind=dbl_kind), parameter ::
+     &     converge = 1.e-10_dbl_kind  ! convergence criterion
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap_bilin
+
+!-----------------------------------------------------------------------
+!
+!     this routine computes the weights for a bilinear interpolation.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n,icount,
+     &     dst_add,        ! destination address
+     &     iter,           ! iteration counter
+     &     nmap            ! index of current map being computed
+
+      integer (kind=int_kind), dimension(4) :: 
+     &     src_add         ! address for the four source points
+
+      real (kind=dbl_kind), dimension(4)  ::
+     &     src_lats,       ! latitudes  of four bilinear corners
+     &     src_lons,       ! longitudes of four bilinear corners
+     &     wgts            ! bilinear weights for four corners
+
+      real (kind=dbl_kind) ::
+     &     plat, plon,       ! lat/lon coords of destination point
+     &     iguess, jguess,   ! current guess for bilinear coordinate
+     &     thguess, phguess, ! current guess for lat/lon coordinate
+     &     deli, delj,       ! corrections to i,j
+     &     dth1, dth2, dth3, ! some latitude  differences
+     &     dph1, dph2, dph3, ! some longitude differences
+     &     dthp, dphp,       ! difference between point and sw corner
+     &     mat1, mat2, mat3, mat4, ! matrix elements
+     &     determinant,      ! matrix determinant
+     &     sum_wgts          ! sum of weights for normalization
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid1 to grid2
+!
+!-----------------------------------------------------------------------
+
+      nmap = 1
+      if (grid1_rank /= 2) then
+        stop 'Can not do bilinear interpolation when grid_rank /= 2'
+      endif
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop1: do dst_add = 1, grid2_size
+
+        if (.not. grid2_mask(dst_add)) cycle grid_loop1
+
+        plat = grid2_center_lat(dst_add)
+        plon = grid2_center_lon(dst_add)
+
+        !***
+        !*** find nearest square of grid points on source grid
+        !***
+
+        call grid_search_bilin(src_add, src_lats, src_lons, 
+     &                         plat, plon, grid1_dims,
+     &                         grid1_center_lat, grid1_center_lon,
+     &                         grid1_bound_box, bin_addr1, bin_addr2)
+
+        !***
+        !*** check to see if points are land points
+        !***
+
+        if (src_add(1) > 0) then
+          do n=1,4
+            if (.not. grid1_mask(src_add(n))) src_add(1) = 0
+          end do
+        endif
+
+        !***
+        !*** if point found, find local i,j coordinates for weights
+        !***
+
+        if (src_add(1) > 0) then
+
+          grid2_frac(dst_add) = one
+
+          !***
+          !*** iterate to find i,j for bilinear approximation
+          !***
+
+          dth1 = src_lats(2) - src_lats(1)
+          dth2 = src_lats(4) - src_lats(1)
+          dth3 = src_lats(3) - src_lats(2) - dth2
+
+          dph1 = src_lons(2) - src_lons(1)
+          dph2 = src_lons(4) - src_lons(1)
+          dph3 = src_lons(3) - src_lons(2)
+
+          if (dph1 >  three*pih) dph1 = dph1 - pi2
+          if (dph2 >  three*pih) dph2 = dph2 - pi2
+          if (dph3 >  three*pih) dph3 = dph3 - pi2
+          if (dph1 < -three*pih) dph1 = dph1 + pi2
+          if (dph2 < -three*pih) dph2 = dph2 + pi2
+          if (dph3 < -three*pih) dph3 = dph3 + pi2
+
+          dph3 = dph3 - dph2
+
+          iguess = half
+          jguess = half
+
+          iter_loop1: do iter=1,max_iter
+
+            dthp = plat - src_lats(1) - dth1*iguess -
+     &                    dth2*jguess - dth3*iguess*jguess
+            dphp = plon - src_lons(1)
+
+            if (dphp >  three*pih) dphp = dphp - pi2
+            if (dphp < -three*pih) dphp = dphp + pi2
+
+            dphp = dphp - dph1*iguess - dph2*jguess - 
+     &                    dph3*iguess*jguess
+
+            mat1 = dth1 + dth3*jguess
+            mat2 = dth2 + dth3*iguess
+            mat3 = dph1 + dph3*jguess
+            mat4 = dph2 + dph3*iguess
+
+            determinant = mat1*mat4 - mat2*mat3
+
+            deli = (dthp*mat4 - mat2*dphp)/determinant
+            delj = (mat1*dphp - dthp*mat3)/determinant
+
+            if (abs(deli) < converge .and. 
+     &          abs(delj) < converge) exit iter_loop1
+
+            iguess = iguess + deli
+            jguess = jguess + delj
+
+          end do iter_loop1
+
+          if (iter <= max_iter) then
+
+            !***
+            !*** successfully found i,j - compute weights
+            !***
+
+            wgts(1) = (one-iguess)*(one-jguess)
+            wgts(2) = iguess*(one-jguess)
+            wgts(3) = iguess*jguess
+            wgts(4) = (one-iguess)*jguess
+
+            call store_link_bilin(dst_add, src_add, wgts, nmap)
+
+          else
+            print *,'Point coords: ',plat,plon
+            print *,'Dest grid lats: ',src_lats
+            print *,'Dest grid lons: ',src_lons
+            print *,'Dest grid addresses: ',src_add
+            print *,'Current i,j : ',iguess, jguess
+            stop 'Iteration for i,j exceed max iteration count'
+          endif
+
+        !***
+        !*** search for bilinear failed - use a distance-weighted
+        !*** average instead (this is typically near the pole)
+        !***
+
+        else if (src_add(1) < 0) then
+
+          src_add = abs(src_add)
+          icount = 0
+          do n=1,4
+            if (grid1_mask(src_add(n))) then
+              icount = icount + 1
+            else
+              src_lats(n) = zero
+            endif
+          end do
+
+          if (icount > 0) then
+            !*** renormalize weights
+
+            sum_wgts = sum(src_lats)
+            wgts(1) = src_lats(1)/sum_wgts
+            wgts(2) = src_lats(2)/sum_wgts
+            wgts(3) = src_lats(3)/sum_wgts
+            wgts(4) = src_lats(4)/sum_wgts
+
+            grid2_frac(dst_add) = one
+            call store_link_bilin(dst_add, src_add, wgts, nmap)
+          endif
+
+        endif
+      end do grid_loop1
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid2 to grid1 if necessary
+!
+!-----------------------------------------------------------------------
+
+      if (num_maps > 1) then
+
+      nmap = 2
+      if (grid2_rank /= 2) then
+        stop 'Can not do bilinear interpolation when grid_rank /= 2'
+      endif
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop2: do dst_add = 1, grid1_size
+
+        if (.not. grid1_mask(dst_add)) cycle grid_loop2
+
+        plat = grid1_center_lat(dst_add)
+        plon = grid1_center_lon(dst_add)
+
+        !***
+        !*** find nearest square of grid points on source grid
+        !***
+
+        call grid_search_bilin(src_add, src_lats, src_lons, 
+     &                         plat, plon, grid2_dims,
+     &                         grid2_center_lat, grid2_center_lon,
+     &                         grid2_bound_box, bin_addr2, bin_addr1)
+
+        !***
+        !*** check to see if points are land points
+        !***
+
+        if (src_add(1) > 0) then
+          do n=1,4
+            if (.not. grid2_mask(src_add(n))) src_add(1) = 0
+          end do
+        endif
+
+        !***
+        !*** if point found, find i,j coordinates for weights
+        !***
+
+        if (src_add(1) > 0) then
+
+          grid1_frac(dst_add) = one
+
+          !***
+          !*** iterate to find i,j for bilinear approximation
+          !***
+
+          dth1 = src_lats(2) - src_lats(1)
+          dth2 = src_lats(4) - src_lats(1)
+          dth3 = src_lats(3) - src_lats(2) - dth2
+
+          dph1 = src_lons(2) - src_lons(1)
+          dph2 = src_lons(4) - src_lons(1)
+          dph3 = src_lons(3) - src_lons(2)
+
+          if (dph1 >  pi) dph1 = dph1 - pi2
+          if (dph2 >  pi) dph2 = dph2 - pi2
+          if (dph3 >  pi) dph3 = dph3 - pi2
+          if (dph1 < -pi) dph1 = dph1 + pi2
+          if (dph2 < -pi) dph2 = dph2 + pi2
+          if (dph3 < -pi) dph3 = dph3 + pi2
+
+          dph3 = dph3 - dph2
+
+          iguess = zero
+          jguess = zero
+
+          iter_loop2: do iter=1,max_iter
+
+            dthp = plat - src_lats(1) - dth1*iguess -
+     &                    dth2*jguess - dth3*iguess*jguess
+            dphp = plon - src_lons(1)
+
+            if (dphp >  pi) dphp = dphp - pi2
+            if (dphp < -pi) dphp = dphp + pi2
+
+            dphp = dphp - dph1*iguess - dph2*jguess - 
+     &                    dph3*iguess*jguess
+
+            mat1 = dth1 + dth3*jguess
+            mat2 = dth2 + dth3*iguess
+            mat3 = dph1 + dph3*jguess
+            mat4 = dph2 + dph3*iguess
+
+            determinant = mat1*mat4 - mat2*mat3
+
+            deli = (dthp*mat4 - mat2*dphp)/determinant
+            delj = (mat1*dphp - dthp*mat3)/determinant
+
+            if (abs(deli) < converge .and. 
+     &          abs(delj) < converge) exit iter_loop2
+
+            iguess = iguess + deli
+            jguess = jguess + delj
+
+          end do iter_loop2
+
+          if (iter <= max_iter) then
+
+            !***
+            !*** successfully found i,j - compute weights
+            !***
+
+            wgts(1) = (one-iguess)*(one-jguess)
+            wgts(2) = iguess*(one-jguess)
+            wgts(3) = iguess*jguess
+            wgts(4) = (one-iguess)*jguess
+
+            call store_link_bilin(dst_add, src_add, wgts, nmap)
+
+          else
+            print *,'Point coords: ',plat,plon
+            print *,'Dest grid lats: ',src_lats
+            print *,'Dest grid lons: ',src_lons
+            print *,'Dest grid addresses: ',src_add
+            print *,'Current i,j : ',iguess, jguess
+            stop 'Iteration for i,j exceed max iteration count'
+          endif
+
+        !***
+        !*** search for bilinear failed - us a distance-weighted
+        !*** average instead
+        !***
+
+        else if (src_add(1) < 0) then
+
+          src_add = abs(src_add)
+          icount = 0
+          do n=1,4
+            if (grid2_mask(src_add(n))) then
+              icount = icount + 1
+            else
+              src_lats(n) = zero
+            endif
+          end do
+
+          if (icount > 0) then
+            !*** renormalize weights
+
+            sum_wgts = sum(src_lats)
+            wgts(1) = src_lats(1)/sum_wgts
+            wgts(2) = src_lats(2)/sum_wgts
+            wgts(3) = src_lats(3)/sum_wgts
+            wgts(4) = src_lats(4)/sum_wgts
+
+            grid1_frac(dst_add) = one
+            call store_link_bilin(dst_add, src_add, wgts, nmap)
+          endif
+
+        endif
+      end do grid_loop2
+
+      endif ! nmap=2
+
+!-----------------------------------------------------------------------
+
+      end subroutine remap_bilin
+
+!***********************************************************************
+
+      subroutine grid_search_bilin(src_add, src_lats, src_lons, 
+     &                             plat, plon, src_grid_dims,
+     &                             src_center_lat, src_center_lon,
+     &                             src_grid_bound_box,
+     &                             src_bin_add, dst_bin_add)
+
+!-----------------------------------------------------------------------
+!
+!     this routine finds the location of the search point plat, plon
+!     in the source grid and returns the corners needed for a bilinear
+!     interpolation.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(4), intent(out) ::
+     &        src_add  ! address of each corner point enclosing P
+
+      real (kind=dbl_kind), dimension(4), intent(out) ::
+     &        src_lats, ! latitudes  of the four corner points
+     &        src_lons  ! longitudes of the four corner points
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), intent(in) ::
+     &        plat,   ! latitude  of the search point
+     &        plon    ! longitude of the search point
+
+      integer (kind=int_kind), dimension(2), intent(in) ::
+     &        src_grid_dims  ! size of each src grid dimension
+
+      real (kind=dbl_kind), dimension(:), intent(in) ::
+     &        src_center_lat, ! latitude  of each src grid center 
+     &        src_center_lon  ! longitude of each src grid center
+
+      real (kind=dbl_kind), dimension(:,:), intent(in) ::
+     &        src_grid_bound_box ! bound box for source grid
+
+      integer (kind=int_kind), dimension(:,:), intent(in) ::
+     &        src_bin_add,    ! latitude bins for restricting
+     &        dst_bin_add     ! searches
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, next_n, srch_add,   ! dummy indices
+     &    nx, ny,            ! dimensions of src grid
+     &    min_add, max_add,  ! addresses for restricting search
+     &    i, j, jp1, ip1, n_add, e_add, ne_add  ! addresses
+
+      real (kind=dbl_kind) ::  ! vectors for cross-product check
+     &      vec1_lat, vec1_lon,
+     &      vec2_lat, vec2_lon, cross_product, cross_product_last,
+     &      coslat_dst, sinlat_dst, coslon_dst, sinlon_dst,
+     &      dist_min, distance ! for computing dist-weighted avg
+
+!-----------------------------------------------------------------------
+!
+!     restrict search first using bins
+!
+!-----------------------------------------------------------------------
+
+      src_add = 0
+
+      min_add = size(src_center_lat)
+      max_add = 1
+      do n=1,num_srch_bins
+        if (plat >= bin_lats(1,n) .and. plat <= bin_lats(2,n) .and.
+     &      plon >= bin_lons(1,n) .and. plon <= bin_lons(2,n)) then
+          min_add = min(min_add, src_bin_add(1,n))
+          max_add = max(max_add, src_bin_add(2,n))
+        endif
+      end do
+ 
+!-----------------------------------------------------------------------
+!
+!     now perform a more detailed search 
+!
+!-----------------------------------------------------------------------
+
+      nx = src_grid_dims(1)
+      ny = src_grid_dims(2)
+
+      srch_loop: do srch_add = min_add,max_add
+
+        !*** first check bounding box
+
+        if (plat <= src_grid_bound_box(2,srch_add) .and. 
+     &      plat >= src_grid_bound_box(1,srch_add) .and.
+     &      plon <= src_grid_bound_box(4,srch_add) .and. 
+     &      plon >= src_grid_bound_box(3,srch_add)) then
+
+          !***
+          !*** we are within bounding box so get really serious
+          !***
+
+          !*** determine neighbor addresses
+
+          j = (srch_add - 1)/nx +1
+          i = srch_add - (j-1)*nx
+
+          if (i < nx) then
+            ip1 = i + 1
+          else
+            ip1 = 1
+          endif
+
+          if (j < ny) then
+            jp1 = j+1
+          else
+            jp1 = 1
+          endif
+
+          n_add = (jp1 - 1)*nx + i
+          e_add = (j - 1)*nx + ip1
+          ne_add = (jp1 - 1)*nx + ip1
+
+          src_lats(1) = src_center_lat(srch_add)
+          src_lats(2) = src_center_lat(e_add)
+          src_lats(3) = src_center_lat(ne_add)
+          src_lats(4) = src_center_lat(n_add)
+
+          src_lons(1) = src_center_lon(srch_add)
+          src_lons(2) = src_center_lon(e_add)
+          src_lons(3) = src_center_lon(ne_add)
+          src_lons(4) = src_center_lon(n_add)
+
+          !***
+          !*** for consistency, we must make sure all lons are in
+          !*** same 2pi interval
+          !***
+
+          vec1_lon = src_lons(1) - plon
+          if (vec1_lon >  pi) then
+            src_lons(1) = src_lons(1) - pi2
+          else if (vec1_lon < -pi) then
+            src_lons(1) = src_lons(1) + pi2
+          endif
+          do n=2,4
+            vec1_lon = src_lons(n) - src_lons(1)
+            if (vec1_lon >  pi) then
+              src_lons(n) = src_lons(n) - pi2
+            else if (vec1_lon < -pi) then
+              src_lons(n) = src_lons(n) + pi2
+            endif
+          end do
+
+          corner_loop: do n=1,4
+            next_n = MOD(n,4) + 1
+
+            !***
+            !*** here we take the cross product of the vector making 
+            !*** up each box side with the vector formed by the vertex
+            !*** and search point.  if all the cross products are 
+            !*** positive, the point is contained in the box.
+            !***
+
+            vec1_lat = src_lats(next_n) - src_lats(n)
+            vec1_lon = src_lons(next_n) - src_lons(n)
+            vec2_lat = plat - src_lats(n)
+            vec2_lon = plon - src_lons(n)
+
+            !***
+            !*** check for 0,2pi crossings
+            !***
+
+            if (vec1_lon >  three*pih) then
+              vec1_lon = vec1_lon - pi2
+            else if (vec1_lon < -three*pih) then
+              vec1_lon = vec1_lon + pi2
+            endif
+            if (vec2_lon >  three*pih) then
+              vec2_lon = vec2_lon - pi2
+            else if (vec2_lon < -three*pih) then
+              vec2_lon = vec2_lon + pi2
+            endif
+
+            cross_product = vec1_lon*vec2_lat - vec2_lon*vec1_lat
+
+            !***
+            !*** if cross product is less than zero, this cell
+            !*** doesn't work
+            !***
+
+            if (n == 1) cross_product_last = cross_product
+            if (cross_product*cross_product_last < zero) 
+     &          exit corner_loop
+            cross_product_last = cross_product
+
+          end do corner_loop
+
+          !***
+          !*** if cross products all same sign, we found the location
+          !***
+
+          if (n > 4) then
+            src_add(1) = srch_add
+            src_add(2) = e_add
+            src_add(3) = ne_add
+            src_add(4) = n_add
+
+            return
+          endif
+
+          !***
+          !*** otherwise move on to next cell
+          !***
+
+        endif !bounding box check
+      end do srch_loop
+
+      !***
+      !*** if no cell found, point is likely either in a box that
+      !*** straddles either pole or is outside the grid.  fall back
+      !*** to a distance-weighted average of the four closest
+      !*** points.  go ahead and compute weights here, but store
+      !*** in src_lats and return -add to prevent the parent
+      !*** routine from computing bilinear weights
+      !***
+
+      !print *,'Could not find location for ',plat,plon
+      !print *,'Using nearest-neighbor average for this point'
+
+      coslat_dst = cos(plat)
+      sinlat_dst = sin(plat)
+      coslon_dst = cos(plon)
+      sinlon_dst = sin(plon)
+
+      dist_min = bignum
+      src_lats = bignum
+      do srch_add = min_add,max_add
+        distance = acos(coslat_dst*cos(src_center_lat(srch_add))*
+     &                 (coslon_dst*cos(src_center_lon(srch_add)) +
+     &                  sinlon_dst*sin(src_center_lon(srch_add)))+
+     &                  sinlat_dst*sin(src_center_lat(srch_add)))
+
+        if (distance < dist_min) then
+          sort_loop: do n=1,4
+            if (distance < src_lats(n)) then
+              do i=4,n+1,-1
+                src_add (i) = src_add (i-1)
+                src_lats(i) = src_lats(i-1)
+              end do
+              src_add (n) = -srch_add
+              src_lats(n) = distance
+              dist_min = src_lats(4)
+              exit sort_loop
+            endif
+          end do sort_loop
+        endif
+      end do
+
+      src_lons = one/(src_lats + tiny)
+      distance = sum(src_lons)
+      src_lats = src_lons/distance
+
+!-----------------------------------------------------------------------
+
+      end subroutine grid_search_bilin 
+
+!***********************************************************************
+
+      subroutine store_link_bilin(dst_add, src_add, weights, nmap)
+
+!-----------------------------------------------------------------------
+!
+!     this routine stores the address and weight for four links 
+!     associated with one destination point in the appropriate address 
+!     and weight arrays and resizes those arrays if necessary.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::
+     &        dst_add,  ! address on destination grid
+     &        nmap      ! identifies which direction for mapping
+
+      integer (kind=int_kind), dimension(4), intent(in) ::
+     &        src_add   ! addresses on source grid
+
+      real (kind=dbl_kind), dimension(4), intent(in) ::
+     &        weights ! array of remapping weights for these links
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, ! dummy index
+     &       num_links_old          ! placeholder for old link number
+
+!-----------------------------------------------------------------------
+!
+!     increment number of links and check to see if remap arrays need
+!     to be increased to accomodate the new link.  then store the
+!     link.
+!
+!-----------------------------------------------------------------------
+
+      select case (nmap)
+      case(1)
+
+        num_links_old  = num_links_map1
+        num_links_map1 = num_links_old + 4
+
+        if (num_links_map1 > max_links_map1) 
+     &     call resize_remap_vars(1,resize_increment)
+
+        do n=1,4
+          grid1_add_map1(num_links_old+n) = src_add(n)
+          grid2_add_map1(num_links_old+n) = dst_add
+          wts_map1    (1,num_links_old+n) = weights(n)
+        end do
+
+      case(2)
+
+        num_links_old  = num_links_map2
+        num_links_map2 = num_links_old + 4
+
+        if (num_links_map2 > max_links_map2) 
+     &     call resize_remap_vars(2,resize_increment)
+
+        do n=1,4
+          grid1_add_map2(num_links_old+n) = dst_add
+          grid2_add_map2(num_links_old+n) = src_add(n)
+          wts_map2    (1,num_links_old+n) = weights(n)
+        end do
+
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine store_link_bilin
+
+!***********************************************************************
+
+      end module remap_bilinear
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_conserv.f
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_conserv.f	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_conserv.f	(revision 2352)
@@ -0,0 +1,2197 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary routines for computing addresses
+!     and weights for a conservative interpolation  between any two 
+!     grids on a sphere.  the weights are computed by performing line 
+!     integrals around all overlap regions of the two grids.  see 
+!     Dukowicz and Kodis, SIAM J. Sci. Stat. Comput. 8, 305 (1987) and
+!     Jones, P.W. Monthly Weather Review (submitted).
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_conserv.f,v 1.10 2001/08/21 21:05:13 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_conservative
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod    ! defines common data types
+      use constants    ! defines common constants
+      use timers       ! module for timing
+      use grids        ! module containing grid information
+      use remap_vars   ! module containing remap information
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), save :: 
+     &        num_srch_cells ! num cells in restricted search arrays
+
+      integer (kind=int_kind), dimension(:), allocatable, save :: 
+     &        srch_add       ! global address of cells in srch arrays
+
+      real (kind=dbl_kind), parameter :: 
+     &     north_thresh = 1.45_dbl_kind, ! threshold for coord transf.
+     &     south_thresh =-2.00_dbl_kind  ! threshold for coord transf.
+
+      real (kind=dbl_kind), dimension(:,:), allocatable, save ::
+     &     srch_corner_lat,  ! lat of each corner of srch cells
+     &     srch_corner_lon   ! lon of each corner of srch cells
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap_conserv
+
+!-----------------------------------------------------------------------
+!
+!     this routine traces the perimeters of every grid cell on each
+!     grid checking for intersections with the other grid and computing
+!     line integrals for each subsegment.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter :: 
+     &        max_subseg = 10000 ! max number of subsegments per segment
+                                 ! to prevent infinite loop
+
+      integer (kind=int_kind) :: 
+     &        grid1_add,  ! current linear address for grid1 cell
+     &        grid2_add,  ! current linear address for grid2 cell
+     &        min_add,    ! addresses for restricting search of
+     &        max_add,    !   destination grid
+     &        n, nwgt,    ! generic counters
+     &        corner,     ! corner of cell that segment starts from
+     &        next_corn,  ! corner of cell that segment ends on
+     &        num_subseg  ! number of subsegments 
+
+      logical (kind=log_kind) :: 
+     &        lcoinc,  ! flag for coincident segments
+     &        lrevers, ! flag for reversing direction of segment
+     &        lbegin   ! flag for first integration of a segment
+
+      logical (kind=log_kind), dimension(:), allocatable ::
+     &        srch_mask   ! mask for restricting searches
+
+      real (kind=dbl_kind) ::
+     &     intrsct_lat, intrsct_lon,       ! lat/lon of next intersect
+     &     beglat, endlat, beglon, endlon, ! endpoints of current seg.
+     &     norm_factor                     ! factor for normalizing wts
+
+      real (kind=dbl_kind), dimension(:), allocatable ::
+     &       grid2_centroid_lat, grid2_centroid_lon, ! centroid coords
+     &       grid1_centroid_lat, grid1_centroid_lon  ! on each grid
+
+      real (kind=dbl_kind), dimension(2) :: begseg ! begin lat/lon for
+                                                   ! full segment
+
+      real (kind=dbl_kind), dimension(6) :: weights ! local wgt array
+
+!-----------------------------------------------------------------------
+!
+!     initialize centroid arrays
+!
+!-----------------------------------------------------------------------
+
+      allocate( grid1_centroid_lat(grid1_size),
+     &          grid1_centroid_lon(grid1_size),
+     &          grid2_centroid_lat(grid2_size),
+     &          grid2_centroid_lon(grid2_size))
+
+      grid1_centroid_lat = zero
+      grid1_centroid_lon = zero
+      grid2_centroid_lat = zero
+      grid2_centroid_lon = zero
+
+!-----------------------------------------------------------------------
+!
+!     integrate around each cell on grid1
+!
+!-----------------------------------------------------------------------
+
+      allocate(srch_mask(grid2_size))
+
+      print *,'grid1 sweep '
+      do grid1_add = 1,grid1_size
+
+        !***
+        !*** restrict searches first using search bins
+        !***
+
+        call timer_start(1)
+        min_add = grid2_size
+        max_add = 1
+        do n=1,num_srch_bins
+          if (grid1_add >= bin_addr1(1,n) .and.
+     &        grid1_add <= bin_addr1(2,n)) then
+            min_add = min(min_add, bin_addr2(1,n))
+            max_add = max(max_add, bin_addr2(2,n))
+          endif
+        end do
+
+        !***
+        !*** further restrict searches using bounding boxes
+        !***
+
+        num_srch_cells = 0
+        do grid2_add = min_add,max_add
+          srch_mask(grid2_add) = (grid2_bound_box(1,grid2_add) <= 
+     &                            grid1_bound_box(2,grid1_add)) .and.
+     &                           (grid2_bound_box(2,grid2_add) >= 
+     &                            grid1_bound_box(1,grid1_add)) .and.
+     &                           (grid2_bound_box(3,grid2_add) <= 
+     &                            grid1_bound_box(4,grid1_add)) .and.
+     &                           (grid2_bound_box(4,grid2_add) >= 
+     &                            grid1_bound_box(3,grid1_add))
+
+          if (srch_mask(grid2_add)) num_srch_cells = num_srch_cells+1
+        end do
+
+        !***
+        !*** create search arrays
+        !***
+
+        allocate(srch_add(num_srch_cells),
+     &           srch_corner_lat(grid2_corners,num_srch_cells),
+     &           srch_corner_lon(grid2_corners,num_srch_cells))
+
+        n = 0
+        gather1: do grid2_add = min_add,max_add
+          if (srch_mask(grid2_add)) then
+            n = n+1
+            srch_add(n) = grid2_add
+            srch_corner_lat(:,n) = grid2_corner_lat(:,grid2_add)
+            srch_corner_lon(:,n) = grid2_corner_lon(:,grid2_add)
+          endif
+        end do gather1
+        call timer_stop(1)
+
+        !***
+        !*** integrate around this cell
+        !***
+
+        do corner = 1,grid1_corners
+          next_corn = mod(corner,grid1_corners) + 1
+
+          !***
+          !*** define endpoints of the current segment
+          !***
+
+          beglat = grid1_corner_lat(corner,grid1_add)
+          beglon = grid1_corner_lon(corner,grid1_add)
+          endlat = grid1_corner_lat(next_corn,grid1_add)
+          endlon = grid1_corner_lon(next_corn,grid1_add)
+          lrevers = .false.
+
+          !***
+          !*** to ensure exact path taken during both
+          !*** sweeps, always integrate segments in the same 
+          !*** direction (SW to NE).
+          !***
+
+          if ((endlat < beglat) .or.
+     &        (endlat == beglat .and. endlon < beglon)) then 
+            beglat = grid1_corner_lat(next_corn,grid1_add)
+            beglon = grid1_corner_lon(next_corn,grid1_add)
+            endlat = grid1_corner_lat(corner,grid1_add)
+            endlon = grid1_corner_lon(corner,grid1_add)
+            lrevers = .true.
+          endif
+
+          begseg(1) = beglat
+          begseg(2) = beglon
+          lbegin = .true.
+          num_subseg = 0
+
+          !***
+          !*** if this is a constant-longitude segment, skip the rest 
+          !*** since the line integral contribution will be zero.
+          !***
+
+          if (endlon /= beglon) then
+
+          !***
+          !*** integrate along this segment, detecting intersections 
+          !*** and computing the line integral for each sub-segment
+          !***
+
+          do while (beglat /= endlat .or. beglon /= endlon)
+
+            !***
+            !*** prevent infinite loops if integration gets stuck
+            !*** near cell or threshold boundary
+            !***
+
+            num_subseg = num_subseg + 1
+            if (num_subseg > max_subseg) then
+              stop 'integration stalled: num_subseg exceeded limit'
+            endif
+
+            !***
+            !*** find next intersection of this segment with a grid
+            !*** line on grid 2.
+            !***
+
+            call timer_start(2)
+            call intersection(grid2_add,intrsct_lat,intrsct_lon,lcoinc,
+     &                        beglat, beglon, endlat, endlon, begseg, 
+     &                        lbegin, lrevers)
+            call timer_stop(2)
+            lbegin = .false.
+
+            !***
+            !*** compute line integral for this subsegment.
+            !***
+
+            call timer_start(3)
+            if (grid2_add /= 0) then
+              call line_integral(weights, num_wts,
+     &                         beglon, intrsct_lon, beglat, intrsct_lat,
+     &                         grid1_center_lat(grid1_add), 
+     &                         grid1_center_lon(grid1_add),
+     &                         grid2_center_lat(grid2_add), 
+     &                         grid2_center_lon(grid2_add))
+            else
+              call line_integral(weights, num_wts,
+     &                         beglon, intrsct_lon, beglat, intrsct_lat,
+     &                         grid1_center_lat(grid1_add), 
+     &                         grid1_center_lon(grid1_add),
+     &                         grid1_center_lat(grid1_add), 
+     &                         grid1_center_lon(grid1_add))
+            endif
+            call timer_stop(3)
+
+            !***
+            !*** if integrating in reverse order, change
+            !*** sign of weights
+            !***
+
+            if (lrevers) then
+              weights = -weights
+            endif
+
+            !***
+            !*** store the appropriate addresses and weights. 
+            !*** also add contributions to cell areas and centroids.
+            !***
+
+            !if (grid1_add == 119247) then
+            !  print *,grid1_add,grid2_add,corner,weights(1)
+            !  print *,grid1_corner_lat(:,grid1_add)
+            !  print *,grid1_corner_lon(:,grid1_add)
+            !  print *,grid2_corner_lat(:,grid2_add)
+            !  print *,grid2_corner_lon(:,grid2_add)
+            !  print *,beglat,beglon,intrsct_lat,intrsct_lon
+            !endif
+
+            if (grid2_add /= 0) then
+              if (grid1_mask(grid1_add)) then
+                call timer_start(4)
+                call store_link_cnsrv(grid1_add, grid2_add, weights)
+                call timer_stop(4)
+                grid1_frac(grid1_add) = grid1_frac(grid1_add) + 
+     &                                  weights(1)
+                grid2_frac(grid2_add) = grid2_frac(grid2_add) + 
+     &                                  weights(num_wts+1)
+              endif
+
+            endif
+
+            grid1_area(grid1_add) = grid1_area(grid1_add) + weights(1)
+            grid1_centroid_lat(grid1_add) = 
+     &      grid1_centroid_lat(grid1_add) + weights(2)
+            grid1_centroid_lon(grid1_add) = 
+     &      grid1_centroid_lon(grid1_add) + weights(3)
+
+            !***
+            !*** reset beglat and beglon for next subsegment.
+            !***
+
+            beglat = intrsct_lat
+            beglon = intrsct_lon
+          end do
+
+          endif
+
+          !***
+          !*** end of segment
+          !***
+
+        end do
+
+        !***
+        !*** finished with this cell: deallocate search array and
+        !*** start on next cell
+
+        deallocate(srch_add, srch_corner_lat, srch_corner_lon)
+
+      end do
+
+      deallocate(srch_mask)
+
+!-----------------------------------------------------------------------
+!
+!     integrate around each cell on grid2
+!
+!-----------------------------------------------------------------------
+
+      allocate(srch_mask(grid1_size))
+
+      print *,'grid2 sweep '
+      do grid2_add = 1,grid2_size
+
+        !***
+        !*** restrict searches first using search bins
+        !***
+
+        call timer_start(5)
+        min_add = grid1_size
+        max_add = 1
+        do n=1,num_srch_bins
+          if (grid2_add >= bin_addr2(1,n) .and.
+     &        grid2_add <= bin_addr2(2,n)) then
+            min_add = min(min_add, bin_addr1(1,n))
+            max_add = max(max_add, bin_addr1(2,n))
+          endif
+        end do
+
+        !***
+        !*** further restrict searches using bounding boxes
+        !***
+
+        num_srch_cells = 0
+        do grid1_add = min_add, max_add
+          srch_mask(grid1_add) = (grid1_bound_box(1,grid1_add) <= 
+     &                            grid2_bound_box(2,grid2_add)) .and.
+     &                           (grid1_bound_box(2,grid1_add) >= 
+     &                            grid2_bound_box(1,grid2_add)) .and.
+     &                           (grid1_bound_box(3,grid1_add) <= 
+     &                            grid2_bound_box(4,grid2_add)) .and.
+     &                           (grid1_bound_box(4,grid1_add) >= 
+     &                            grid2_bound_box(3,grid2_add))
+
+          if (srch_mask(grid1_add)) num_srch_cells = num_srch_cells+1
+        end do
+
+        allocate(srch_add(num_srch_cells),
+     &           srch_corner_lat(grid1_corners,num_srch_cells),
+     &           srch_corner_lon(grid1_corners,num_srch_cells))
+
+        n = 0
+        gather2: do grid1_add = min_add,max_add
+          if (srch_mask(grid1_add)) then
+            n = n+1
+            srch_add(n) = grid1_add
+            srch_corner_lat(:,n) = grid1_corner_lat(:,grid1_add)
+            srch_corner_lon(:,n) = grid1_corner_lon(:,grid1_add)
+          endif
+        end do gather2
+        call timer_stop(5)
+
+        !***
+        !*** integrate around this cell
+        !***
+
+        do corner = 1,grid2_corners
+          next_corn = mod(corner,grid2_corners) + 1
+
+          beglat = grid2_corner_lat(corner,grid2_add)
+          beglon = grid2_corner_lon(corner,grid2_add)
+          endlat = grid2_corner_lat(next_corn,grid2_add)
+          endlon = grid2_corner_lon(next_corn,grid2_add)
+          lrevers = .false.
+
+          !***
+          !*** to ensure exact path taken during both
+          !*** sweeps, always integrate in the same direction
+          !***
+
+          if ((endlat < beglat) .or.
+     &        (endlat == beglat .and. endlon < beglon)) then 
+            beglat = grid2_corner_lat(next_corn,grid2_add)
+            beglon = grid2_corner_lon(next_corn,grid2_add)
+            endlat = grid2_corner_lat(corner,grid2_add)
+            endlon = grid2_corner_lon(corner,grid2_add)
+            lrevers = .true.
+          endif
+
+          begseg(1) = beglat
+          begseg(2) = beglon
+          lbegin = .true.
+
+          !***
+          !*** if this is a constant-longitude segment, skip the rest 
+          !*** since the line integral contribution will be zero.
+          !***
+
+          if (endlon /= beglon) then
+          num_subseg = 0
+
+          !***
+          !*** integrate along this segment, detecting intersections 
+          !*** and computing the line integral for each sub-segment
+          !***
+
+          do while (beglat /= endlat .or. beglon /= endlon)
+
+            !***
+            !*** prevent infinite loops if integration gets stuck
+            !*** near cell or threshold boundary
+            !***
+
+            num_subseg = num_subseg + 1
+            if (num_subseg > max_subseg) then
+              stop 'integration stalled: num_subseg exceeded limit'
+            endif
+
+            !***
+            !*** find next intersection of this segment with a line 
+            !*** on grid 2.
+            !***
+
+            call timer_start(6)
+            call intersection(grid1_add,intrsct_lat,intrsct_lon,lcoinc,
+     &                        beglat, beglon, endlat, endlon, begseg,
+     &                        lbegin, lrevers)
+            call timer_stop(6)
+            lbegin = .false.
+
+            !***
+            !*** compute line integral for this subsegment.
+            !***
+
+            call timer_start(7)
+            if (grid1_add /= 0) then
+              call line_integral(weights, num_wts,
+     &                         beglon, intrsct_lon, beglat, intrsct_lat,
+     &                         grid1_center_lat(grid1_add), 
+     &                         grid1_center_lon(grid1_add),
+     &                         grid2_center_lat(grid2_add), 
+     &                         grid2_center_lon(grid2_add))
+            else
+              call line_integral(weights, num_wts,
+     &                         beglon, intrsct_lon, beglat, intrsct_lat,
+     &                         grid2_center_lat(grid2_add), 
+     &                         grid2_center_lon(grid2_add),
+     &                         grid2_center_lat(grid2_add), 
+     &                         grid2_center_lon(grid2_add))
+            endif
+            call timer_stop(7)
+
+            if (lrevers) then
+              weights = -weights
+            endif
+
+            !***
+            !*** store the appropriate addresses and weights. 
+            !*** also add contributions to cell areas and centroids.
+            !*** if there is a coincidence, do not store weights
+            !*** because they have been captured in the previous loop.
+            !*** the grid1 mask is the master mask
+            !***
+
+            !if (grid1_add == 119247) then
+            !  print *,grid1_add,grid2_add,corner,weights(1)
+            !  print *,grid1_corner_lat(:,grid1_add)
+            !  print *,grid1_corner_lon(:,grid1_add)
+            !  print *,grid2_corner_lat(:,grid2_add)
+            !  print *,grid2_corner_lon(:,grid2_add)
+            !  print *,beglat,beglon,intrsct_lat,intrsct_lon
+            !endif
+
+            if (.not. lcoinc .and. grid1_add /= 0) then
+              if (grid1_mask(grid1_add)) then
+                call timer_start(8)
+                call store_link_cnsrv(grid1_add, grid2_add, weights)
+                call timer_stop(8)
+                grid1_frac(grid1_add) = grid1_frac(grid1_add) + 
+     &                                  weights(1)
+                grid2_frac(grid2_add) = grid2_frac(grid2_add) + 
+     &                                  weights(num_wts+1)
+              endif
+
+            endif
+
+            grid2_area(grid2_add) = grid2_area(grid2_add) + 
+     &                                      weights(num_wts+1)
+            grid2_centroid_lat(grid2_add) = 
+     &      grid2_centroid_lat(grid2_add) + weights(num_wts+2)
+            grid2_centroid_lon(grid2_add) = 
+     &      grid2_centroid_lon(grid2_add) + weights(num_wts+3)
+
+            !***
+            !*** reset beglat and beglon for next subsegment.
+            !***
+
+            beglat = intrsct_lat
+            beglon = intrsct_lon
+          end do
+
+          endif
+
+          !***
+          !*** end of segment
+          !***
+
+        end do
+
+        !***
+        !*** finished with this cell: deallocate search array and
+        !*** start on next cell
+
+        deallocate(srch_add, srch_corner_lat, srch_corner_lon)
+
+      end do
+
+      deallocate(srch_mask)
+
+!-----------------------------------------------------------------------
+!
+!     correct for situations where N/S pole not explicitly included in
+!     grid (i.e. as a grid corner point). if pole is missing from only
+!     one grid, need to correct only the area and centroid of that 
+!     grid.  if missing from both, do complete weight calculation.
+!
+!-----------------------------------------------------------------------
+
+      !*** North Pole
+      weights(1) =  pi2
+      weights(2) =  pi*pi
+      weights(3) =  zero
+      weights(4) =  pi2
+      weights(5) =  pi*pi
+      weights(6) =  zero
+
+      grid1_add = 0
+      pole_loop1: do n=1,grid1_size
+        if (grid1_area(n) < -three*pih .and.
+     &      grid1_center_lat(n) > zero) then
+          grid1_add = n
+          exit pole_loop1
+        endif
+      end do pole_loop1
+
+      grid2_add = 0
+      pole_loop2: do n=1,grid2_size
+        if (grid2_area(n) < -three*pih .and.
+     &      grid2_center_lat(n) > zero) then
+          grid2_add = n
+          exit pole_loop2
+        endif
+      end do pole_loop2
+
+      if (grid1_add /=0) then
+        grid1_area(grid1_add) = grid1_area(grid1_add) + weights(1)
+        grid1_centroid_lat(grid1_add) = 
+     &  grid1_centroid_lat(grid1_add) + weights(2)
+        grid1_centroid_lon(grid1_add) =
+     &  grid1_centroid_lon(grid1_add) + weights(3)
+      endif
+
+      if (grid2_add /=0) then
+        grid2_area(grid2_add) = grid2_area(grid2_add) + 
+     &                                  weights(num_wts+1)
+        grid2_centroid_lat(grid2_add) = 
+     &  grid2_centroid_lat(grid2_add) + weights(num_wts+2)
+        grid2_centroid_lon(grid2_add) =
+     &  grid2_centroid_lon(grid2_add) + weights(num_wts+3)
+      endif
+
+      if (grid1_add /= 0 .and. grid2_add /=0) then
+        call store_link_cnsrv(grid1_add, grid2_add, weights)
+
+        grid1_frac(grid1_add) = grid1_frac(grid1_add) + 
+     &                          weights(1)
+        grid2_frac(grid2_add) = grid2_frac(grid2_add) + 
+     &                          weights(num_wts+1)
+      endif
+
+      !*** South Pole
+      weights(1) =  pi2
+      weights(2) = -pi*pi
+      weights(3) =  zero
+      weights(4) =  pi2
+      weights(5) = -pi*pi
+      weights(6) =  zero
+
+      grid1_add = 0
+      pole_loop3: do n=1,grid1_size
+        if (grid1_area(n) < -three*pih .and.
+     &      grid1_center_lat(n) < zero) then
+          grid1_add = n
+          exit pole_loop3
+        endif
+      end do pole_loop3
+
+      grid2_add = 0
+      pole_loop4: do n=1,grid2_size
+        if (grid2_area(n) < -three*pih .and.
+     &      grid2_center_lat(n) < zero) then
+          grid2_add = n
+          exit pole_loop4
+        endif
+      end do pole_loop4
+
+      if (grid1_add /=0) then
+        grid1_area(grid1_add) = grid1_area(grid1_add) + weights(1)
+        grid1_centroid_lat(grid1_add) = 
+     &  grid1_centroid_lat(grid1_add) + weights(2)
+        grid1_centroid_lon(grid1_add) =
+     &  grid1_centroid_lon(grid1_add) + weights(3)
+      endif
+
+      if (grid2_add /=0) then
+        grid2_area(grid2_add) = grid2_area(grid2_add) + 
+     &                                  weights(num_wts+1)
+        grid2_centroid_lat(grid2_add) = 
+     &  grid2_centroid_lat(grid2_add) + weights(num_wts+2)
+        grid2_centroid_lon(grid2_add) =
+     &  grid2_centroid_lon(grid2_add) + weights(num_wts+3)
+      endif
+
+      if (grid1_add /= 0 .and. grid2_add /=0) then
+        call store_link_cnsrv(grid1_add, grid2_add, weights)
+
+        grid1_frac(grid1_add) = grid1_frac(grid1_add) + 
+     &                          weights(1)
+        grid2_frac(grid2_add) = grid2_frac(grid2_add) + 
+     &                          weights(num_wts+1)
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     finish centroid computation
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_area /= zero)
+        grid1_centroid_lat = grid1_centroid_lat/grid1_area
+        grid1_centroid_lon = grid1_centroid_lon/grid1_area
+      end where
+
+      where (grid2_area /= zero)
+        grid2_centroid_lat = grid2_centroid_lat/grid2_area
+        grid2_centroid_lon = grid2_centroid_lon/grid2_area
+      end where
+
+!-----------------------------------------------------------------------
+!
+!     include centroids in weights and normalize using destination
+!     area if requested
+!
+!-----------------------------------------------------------------------
+
+      do n=1,num_links_map1
+        grid1_add = grid1_add_map1(n)
+        grid2_add = grid2_add_map1(n)
+        do nwgt=1,num_wts
+          weights(        nwgt) = wts_map1(nwgt,n)
+          if (num_maps > 1) then
+            weights(num_wts+nwgt) = wts_map2(nwgt,n)
+          endif
+        end do
+
+        select case(norm_opt)
+        case (norm_opt_dstarea)
+          if (grid2_area(grid2_add) /= zero) then
+            if (luse_grid2_area) then
+              norm_factor = one/grid2_area_in(grid2_add)
+            else
+              norm_factor = one/grid2_area(grid2_add)
+            endif
+          else
+            norm_factor = zero
+          endif
+        case (norm_opt_frcarea)
+          if (grid2_frac(grid2_add) /= zero) then
+            if (luse_grid2_area) then
+              norm_factor = grid2_area(grid2_add)/
+     &                     (grid2_frac(grid2_add)*
+     &                      grid2_area_in(grid2_add))
+            else
+              norm_factor = one/grid2_frac(grid2_add)
+            endif
+          else
+            norm_factor = zero
+          endif
+        case (norm_opt_none)
+          norm_factor = one
+        end select
+
+        wts_map1(1,n) =  weights(1)*norm_factor
+        wts_map1(2,n) = (weights(2) - weights(1)*
+     &                              grid1_centroid_lat(grid1_add))*
+     &                              norm_factor
+        wts_map1(3,n) = (weights(3) - weights(1)*
+     &                              grid1_centroid_lon(grid1_add))*
+     &                              norm_factor
+
+        if (num_maps > 1) then
+          select case(norm_opt)
+          case (norm_opt_dstarea)
+            if (grid1_area(grid1_add) /= zero) then
+              if (luse_grid1_area) then
+                norm_factor = one/grid1_area_in(grid1_add)
+              else
+                norm_factor = one/grid1_area(grid1_add)
+              endif
+            else
+              norm_factor = zero
+            endif
+          case (norm_opt_frcarea)
+            if (grid1_frac(grid1_add) /= zero) then
+              if (luse_grid1_area) then
+                norm_factor = grid1_area(grid1_add)/
+     &                       (grid1_frac(grid1_add)*
+     &                        grid1_area_in(grid1_add))
+              else
+                norm_factor = one/grid1_frac(grid1_add)
+              endif
+            else
+              norm_factor = zero
+            endif
+          case (norm_opt_none)
+            norm_factor = one
+          end select
+
+          wts_map2(1,n) =  weights(num_wts+1)*norm_factor
+          wts_map2(2,n) = (weights(num_wts+2) - weights(num_wts+1)*
+     &                                grid2_centroid_lat(grid2_add))*
+     &                                norm_factor
+          wts_map2(3,n) = (weights(num_wts+3) - weights(num_wts+1)*
+     &                                grid2_centroid_lon(grid2_add))*
+     &                                norm_factor
+        endif
+
+      end do
+
+      print *, 'Total number of links = ',num_links_map1
+
+      where (grid1_area /= zero) grid1_frac = grid1_frac/grid1_area
+      where (grid2_area /= zero) grid2_frac = grid2_frac/grid2_area
+
+!-----------------------------------------------------------------------
+!
+!     perform some error checking on final weights
+!
+!-----------------------------------------------------------------------
+
+      grid2_centroid_lat = zero
+      grid2_centroid_lon = zero
+
+      do n=1,grid1_size
+        if (grid1_area(n) < -.01) then
+          print *,'Grid 1 area error: ',n,grid1_area(n)
+        endif
+        if (grid1_centroid_lat(n) < -pih-.01 .or.
+     &      grid1_centroid_lat(n) >  pih+.01) then
+          print *,'Grid 1 centroid lat error: ',n,grid1_centroid_lat(n)
+        endif
+        grid1_centroid_lat(n) = zero
+        grid1_centroid_lon(n) = zero
+      end do
+
+      do n=1,grid2_size
+        if (grid2_area(n) < -.01) then
+          print *,'Grid 2 area error: ',n,grid2_area(n)
+        endif
+        if (grid2_centroid_lat(n) < -pih-.01 .or.
+     &      grid2_centroid_lat(n) >  pih+.01) then
+          print *,'Grid 2 centroid lat error: ',n,grid2_centroid_lat(n)
+        endif
+        grid2_centroid_lat(n) = zero
+        grid2_centroid_lon(n) = zero
+      end do
+
+      do n=1,num_links_map1
+        grid1_add = grid1_add_map1(n)
+        grid2_add = grid2_add_map1(n)
+        
+        if (wts_map1(1,n) < -.01) then
+          print *,'Map 1 weight < 0 ',grid1_add,grid2_add,wts_map1(1,n)
+        endif
+        if (norm_opt /= norm_opt_none .and. wts_map1(1,n) > 1.01) then
+          print *,'Map 1 weight > 1 ',grid1_add,grid2_add,wts_map1(1,n)
+        endif
+        grid2_centroid_lat(grid2_add) = 
+     &  grid2_centroid_lat(grid2_add) + wts_map1(1,n)
+
+        if (num_maps > 1) then
+          if (wts_map2(1,n) < -.01) then
+            print *,'Map 2 weight < 0 ',grid1_add,grid2_add,
+     &                                  wts_map2(1,n)
+          endif
+          if (norm_opt /= norm_opt_none .and. wts_map2(1,n) > 1.01) then
+            print *,'Map 2 weight < 0 ',grid1_add,grid2_add,
+     &                                  wts_map2(1,n)
+          endif
+          grid1_centroid_lat(grid1_add) = 
+     &    grid1_centroid_lat(grid1_add) + wts_map2(1,n)
+        endif
+      end do
+
+      do n=1,grid2_size
+        select case(norm_opt)
+        case (norm_opt_dstarea)
+          norm_factor = grid2_frac(grid2_add)
+        case (norm_opt_frcarea)
+          norm_factor = one
+        case (norm_opt_none)
+          if (luse_grid2_area) then
+            norm_factor = grid2_area_in(grid2_add)
+          else
+            norm_factor = grid2_area(grid2_add)
+          endif
+        end select
+        if (abs(grid2_centroid_lat(grid2_add)-norm_factor) > .01) then
+          print *,'Error: sum of wts for map1 ',grid2_add,
+     &            grid2_centroid_lat(grid2_add),norm_factor
+        endif
+      end do
+
+      if (num_maps > 1) then
+        do n=1,grid1_size
+          select case(norm_opt)
+          case (norm_opt_dstarea)
+            norm_factor = grid1_frac(grid1_add)
+          case (norm_opt_frcarea)
+            norm_factor = one
+          case (norm_opt_none)
+            if (luse_grid1_area) then
+              norm_factor = grid1_area_in(grid1_add)
+            else
+              norm_factor = grid1_area(grid1_add)
+            endif
+          end select
+          if (abs(grid1_centroid_lat(grid1_add)-norm_factor) > .01) then
+            print *,'Error: sum of wts for map2 ',grid1_add,
+     &              grid1_centroid_lat(grid1_add),norm_factor
+          endif
+        end do
+      endif
+!-----------------------------------------------------------------------
+
+      end subroutine remap_conserv
+
+!***********************************************************************
+
+      subroutine intersection(location,intrsct_lat,intrsct_lon,lcoinc,
+     &                        beglat, beglon, endlat, endlon, begseg,
+     &                        lbegin, lrevers)
+
+!-----------------------------------------------------------------------
+!
+!     this routine finds the next intersection of a destination grid 
+!     line with the line segment given by beglon, endlon, etc.
+!     a coincidence flag is returned if the segment is entirely 
+!     coincident with an ocean grid line.  the cells in which to search
+!     for an intersection must have already been restricted in the
+!     calling routine.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     intent(in): 
+!
+!-----------------------------------------------------------------------
+
+      logical (kind=log_kind), intent(in) ::
+     &     lbegin, ! flag for first integration along this segment
+     &     lrevers ! flag whether segment integrated in reverse
+
+      real (kind=dbl_kind), intent(in) :: 
+     &     beglat, beglon,  ! beginning lat/lon endpoints for segment
+     &     endlat, endlon   ! ending    lat/lon endpoints for segment
+
+      real (kind=dbl_kind), dimension(2), intent(inout) :: 
+     &     begseg ! begin lat/lon of full segment
+
+!-----------------------------------------------------------------------
+!
+!     intent(out): 
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(out) ::
+     &        location  ! address in destination array containing this
+                        ! segment
+
+      logical (kind=log_kind), intent(out) ::
+     &        lcoinc    ! flag segments which are entirely coincident
+                        ! with a grid line
+
+      real (kind=dbl_kind), intent(out) ::
+     &     intrsct_lat, intrsct_lon ! lat/lon coords of next intersect.
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, next_n, cell, srch_corners, pole_loc
+
+      integer (kind=int_kind), save :: 
+     &     last_loc  ! save location when crossing threshold
+
+      logical (kind=log_kind) :: 
+     &     loutside  ! flags points outside grid
+
+      logical (kind=log_kind), save :: 
+     &     lthresh = .false.  ! flags segments crossing threshold bndy
+
+      real (kind=dbl_kind) ::
+     &     lon1, lon2,       ! local longitude variables for segment
+     &     lat1, lat2,       ! local latitude  variables for segment
+     &     grdlon1, grdlon2, ! local longitude variables for grid cell
+     &     grdlat1, grdlat2, ! local latitude  variables for grid cell
+     &     vec1_lat, vec1_lon, ! vectors and cross products used
+     &     vec2_lat, vec2_lon, ! during grid search
+     &     cross_product, 
+     &     eps, offset,        ! small offset away from intersect
+     &     s1, s2, determ,     ! variables used for linear solve to
+     &     mat1, mat2, mat3, mat4, rhs1, rhs2  ! find intersection
+
+      real (kind=dbl_kind), save ::
+     &     intrsct_lat_off, intrsct_lon_off ! lat/lon coords offset 
+                                            ! for next search
+
+!-----------------------------------------------------------------------
+!
+!     initialize defaults, flags, etc.
+!
+!-----------------------------------------------------------------------
+
+      location = 0
+      lcoinc = .false.
+      intrsct_lat = endlat
+      intrsct_lon = endlon
+
+      if (num_srch_cells == 0) return
+
+      if (beglat > north_thresh .or. beglat < south_thresh) then
+
+        if (lthresh) location = last_loc
+        call pole_intersection(location,
+     &               intrsct_lat,intrsct_lon,lcoinc,lthresh,
+     &               beglat, beglon, endlat, endlon, begseg, lrevers)
+        if (lthresh) then
+          last_loc = location
+          intrsct_lat_off = intrsct_lat
+          intrsct_lon_off = intrsct_lon
+        endif
+        return
+
+      endif
+
+      loutside = .false.
+      if (lbegin) then
+        lat1 = beglat
+        lon1 = beglon
+      else
+        lat1 = intrsct_lat_off
+        lon1 = intrsct_lon_off
+      endif
+      lat2 = endlat
+      lon2 = endlon
+      if ((lon2-lon1) > three*pih) then
+        lon2 = lon2 - pi2
+      else if ((lon2-lon1) < -three*pih) then
+        lon2 = lon2 + pi2
+      endif
+      s1 = zero
+
+!-----------------------------------------------------------------------
+!
+!     search for location of this segment in ocean grid using cross
+!     product method to determine whether a point is enclosed by a cell
+!
+!-----------------------------------------------------------------------
+
+      call timer_start(12)
+      srch_corners = size(srch_corner_lat,DIM=1)
+      srch_loop: do
+
+        !***
+        !*** if last segment crossed threshold, use that location
+        !***
+
+        if (lthresh) then
+          do cell=1,num_srch_cells
+            if (srch_add(cell) == last_loc) then
+              location = last_loc
+              eps = tiny
+              exit srch_loop
+            endif
+          end do
+        endif
+
+        !***
+        !*** otherwise normal search algorithm
+        !***
+
+        cell_loop: do cell=1,num_srch_cells
+          corner_loop: do n=1,srch_corners
+            next_n = MOD(n,srch_corners) + 1
+
+            !***
+            !*** here we take the cross product of the vector making 
+            !*** up each cell side with the vector formed by the vertex
+            !*** and search point.  if all the cross products are 
+            !*** positive, the point is contained in the cell.
+            !***
+
+            vec1_lat = srch_corner_lat(next_n,cell) - 
+     &                 srch_corner_lat(n     ,cell)
+            vec1_lon = srch_corner_lon(next_n,cell) - 
+     &                 srch_corner_lon(n     ,cell)
+            vec2_lat = lat1 - srch_corner_lat(n,cell)
+            vec2_lon = lon1 - srch_corner_lon(n,cell)
+
+            !***
+            !*** if endpoint coincident with vertex, offset
+            !*** the endpoint
+            !***
+
+            if (vec2_lat == 0 .and. vec2_lon == 0) then
+              lat1 = lat1 + 1.d-10*(lat2-lat1)
+              lon1 = lon1 + 1.d-10*(lon2-lon1)
+              vec2_lat = lat1 - srch_corner_lat(n,cell)
+              vec2_lon = lon1 - srch_corner_lon(n,cell)
+            endif
+
+            !***
+            !*** check for 0,2pi crossings
+            !***
+
+            if (vec1_lon >  pi) then
+              vec1_lon = vec1_lon - pi2
+            else if (vec1_lon < -pi) then
+              vec1_lon = vec1_lon + pi2
+            endif
+            if (vec2_lon >  pi) then
+              vec2_lon = vec2_lon - pi2
+            else if (vec2_lon < -pi) then
+              vec2_lon = vec2_lon + pi2
+            endif
+
+            cross_product = vec1_lon*vec2_lat - vec2_lon*vec1_lat
+
+            !***
+            !*** if the cross product for a side is zero, the point 
+            !***   lies exactly on the side or the side is degenerate
+            !***   (zero length).  if degenerate, set the cross 
+            !***   product to a positive number.  otherwise perform 
+            !***   another cross product between the side and the 
+            !***   segment itself. 
+            !*** if this cross product is also zero, the line is 
+            !***   coincident with the cell boundary - perform the 
+            !***   dot product and only choose the cell if the dot 
+            !***   product is positive (parallel vs anti-parallel).
+            !***
+
+            if (cross_product == zero) then
+              if (vec1_lat /= zero .or. vec1_lon /= zero) then
+                vec2_lat = lat2 - lat1
+                vec2_lon = lon2 - lon1
+
+                if (vec2_lon >  pi) then
+                  vec2_lon = vec2_lon - pi2
+                else if (vec2_lon < -pi) then
+                  vec2_lon = vec2_lon + pi2
+                endif
+
+                cross_product = vec1_lon*vec2_lat - vec2_lon*vec1_lat
+              else
+                cross_product = one
+              endif
+
+              if (cross_product == zero) then
+                lcoinc = .true.
+                cross_product = vec1_lon*vec2_lon + vec1_lat*vec2_lat
+                if (lrevers) cross_product = -cross_product
+              endif
+            endif
+
+            !***
+            !*** if cross product is less than zero, this cell
+            !*** doesn't work
+            !***
+
+            if (cross_product < zero) exit corner_loop
+
+          end do corner_loop
+
+          !***
+          !*** if cross products all positive, we found the location
+          !***
+
+          if (n > srch_corners) then
+            location = srch_add(cell)
+
+            !***
+            !*** if the beginning of this segment was outside the
+            !*** grid, invert the segment so the intersection found
+            !*** will be the first intersection with the grid
+            !***
+
+            if (loutside) then
+              lat2 = beglat
+              lon2 = beglon
+              location = 0
+              eps  = -tiny
+            else
+              eps  = tiny
+            endif
+
+            exit srch_loop
+          endif
+
+          !***
+          !*** otherwise move on to next cell
+          !***
+
+        end do cell_loop
+
+        !***
+        !*** if still no cell found, the point lies outside the grid.
+        !***   take some baby steps along the segment to see if any
+        !***   part of the segment lies inside the grid.  
+        !***
+
+        loutside = .true.
+        s1 = s1 + 0.001_dbl_kind
+        lat1 = beglat + s1*(endlat - beglat)
+        lon1 = beglon + s1*(lon2   - beglon)
+
+        !***
+        !*** reached the end of the segment and still outside the grid
+        !*** return no intersection
+        !***
+
+        if (s1 >= one) return
+
+      end do srch_loop
+      call timer_stop(12)
+
+!-----------------------------------------------------------------------
+!
+!     now that a cell is found, search for the next intersection.
+!     loop over sides of the cell to find intersection with side
+!     must check all sides for coincidences or intersections
+!
+!-----------------------------------------------------------------------
+
+      call timer_start(13)
+      intrsct_loop: do n=1,srch_corners
+        next_n = mod(n,srch_corners) + 1
+
+        grdlon1 = srch_corner_lon(n     ,cell)
+        grdlon2 = srch_corner_lon(next_n,cell)
+        grdlat1 = srch_corner_lat(n     ,cell)
+        grdlat2 = srch_corner_lat(next_n,cell)
+
+        !***
+        !*** set up linear system to solve for intersection
+        !***
+
+        mat1 = lat2 - lat1
+        mat2 = grdlat1 - grdlat2
+        mat3 = lon2 - lon1
+        mat4 = grdlon1 - grdlon2
+        rhs1 = grdlat1 - lat1
+        rhs2 = grdlon1 - lon1
+
+        if (mat3 >  pi) then
+          mat3 = mat3 - pi2
+        else if (mat3 < -pi) then
+          mat3 = mat3 + pi2
+        endif
+        if (mat4 >  pi) then
+          mat4 = mat4 - pi2
+        else if (mat4 < -pi) then
+          mat4 = mat4 + pi2
+        endif
+        if (rhs2 >  pi) then
+          rhs2 = rhs2 - pi2
+        else if (rhs2 < -pi) then
+          rhs2 = rhs2 + pi2
+        endif
+
+        determ = mat1*mat4 - mat2*mat3
+
+        !***
+        !*** if the determinant is zero, the segments are either 
+        !***   parallel or coincident.  coincidences were detected 
+        !***   above so do nothing.
+        !*** if the determinant is non-zero, solve for the linear 
+        !***   parameters s for the intersection point on each line 
+        !***   segment.
+        !*** if 0<s1,s2<1 then the segment intersects with this side.
+        !***   return the point of intersection (adding a small
+        !***   number so the intersection is off the grid line).
+        !***
+
+        if (abs(determ) > 1.e-30) then
+
+          s1 = (rhs1*mat4 - mat2*rhs2)/determ
+          s2 = (mat1*rhs2 - rhs1*mat3)/determ
+
+          if (s2 >= zero .and. s2 <= one .and.
+     &        s1 >  zero. and. s1 <= one) then
+
+            !***
+            !*** recompute intersection based on full segment
+            !*** so intersections are consistent for both sweeps
+            !***
+
+            if (.not. loutside) then
+              mat1 = lat2 - begseg(1)
+              mat3 = lon2 - begseg(2)
+              rhs1 = grdlat1 - begseg(1)
+              rhs2 = grdlon1 - begseg(2)
+            else
+              mat1 = begseg(1) - endlat
+              mat3 = begseg(2) - endlon
+              rhs1 = grdlat1 - endlat
+              rhs2 = grdlon1 - endlon
+            endif
+
+            if (mat3 >  pi) then
+              mat3 = mat3 - pi2
+            else if (mat3 < -pi) then
+              mat3 = mat3 + pi2
+            endif
+            if (rhs2 >  pi) then
+              rhs2 = rhs2 - pi2
+            else if (rhs2 < -pi) then
+              rhs2 = rhs2 + pi2
+            endif
+
+            determ = mat1*mat4 - mat2*mat3
+
+            !***
+            !*** sometimes due to roundoff, the previous 
+            !*** determinant is non-zero, but the lines
+            !*** are actually coincident.  if this is the
+            !*** case, skip the rest.
+            !***
+
+            if (determ /= zero) then
+              s1 = (rhs1*mat4 - mat2*rhs2)/determ
+              s2 = (mat1*rhs2 - rhs1*mat3)/determ
+
+              offset = s1 + eps/determ
+              if (offset > one) offset = one
+
+              if (.not. loutside) then
+                intrsct_lat = begseg(1) + mat1*s1
+                intrsct_lon = begseg(2) + mat3*s1
+                intrsct_lat_off = begseg(1) + mat1*offset
+                intrsct_lon_off = begseg(2) + mat3*offset
+              else
+                intrsct_lat = endlat + mat1*s1
+                intrsct_lon = endlon + mat3*s1
+                intrsct_lat_off = endlat + mat1*offset
+                intrsct_lon_off = endlon + mat3*offset
+              endif
+              exit intrsct_loop
+            endif
+
+          endif
+        endif
+
+        !***
+        !*** no intersection this side, move on to next side
+        !***
+
+      end do intrsct_loop
+      call timer_stop(13)
+
+!-----------------------------------------------------------------------
+!
+!     if the segment crosses a pole threshold, reset the intersection
+!     to be the threshold latitude.  only check if this was not a
+!     threshold segment since sometimes coordinate transform can end
+!     up on other side of threshold again.
+!
+!-----------------------------------------------------------------------
+
+      if (lthresh) then
+        if (intrsct_lat < north_thresh .or. intrsct_lat > south_thresh)
+     &      lthresh = .false.
+      else if (lat1 > zero .and. intrsct_lat > north_thresh) then
+        intrsct_lat = north_thresh + tiny
+        intrsct_lat_off = north_thresh + eps*mat1
+        s1 = (intrsct_lat - begseg(1))/mat1
+        intrsct_lon     = begseg(2) + s1*mat3
+        intrsct_lon_off = begseg(2) + (s1+eps)*mat3
+        last_loc = location
+        lthresh = .true.
+      else if (lat1 < zero .and. intrsct_lat < south_thresh) then
+        intrsct_lat = south_thresh - tiny
+        intrsct_lat_off = south_thresh + eps*mat1
+        s1 = (intrsct_lat - begseg(1))/mat1
+        intrsct_lon     = begseg(2) + s1*mat3
+        intrsct_lon_off = begseg(2) + (s1+eps)*mat3
+        last_loc = location
+        lthresh = .true.
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine intersection
+
+!***********************************************************************
+
+      subroutine pole_intersection(location,
+     &                 intrsct_lat,intrsct_lon,lcoinc,lthresh,
+     &                 beglat, beglon, endlat, endlon, begseg, lrevers)
+
+!-----------------------------------------------------------------------
+!
+!     this routine is identical to the intersection routine except
+!     that a coordinate transformation (using a Lambert azimuthal
+!     equivalent projection) is performed to treat polar cells more
+!     accurately.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     intent(in): 
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), intent(in) :: 
+     &     beglat, beglon,  ! beginning lat/lon endpoints for segment
+     &     endlat, endlon   ! ending    lat/lon endpoints for segment
+
+      real (kind=dbl_kind), dimension(2), intent(inout) :: 
+     &     begseg ! begin lat/lon of full segment
+
+      logical (kind=log_kind), intent(in) ::
+     &        lrevers   ! flag true if segment integrated in reverse
+
+!-----------------------------------------------------------------------
+!
+!     intent(out): 
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(inout) ::
+     &        location  ! address in destination array containing this
+                        ! segment -- also may contain last location on
+                        ! entry
+
+      logical (kind=log_kind), intent(out) ::
+     &        lcoinc    ! flag segment coincident with grid line
+
+      logical (kind=log_kind), intent(inout) ::
+     &        lthresh   ! flag segment crossing threshold boundary
+
+      real (kind=dbl_kind), intent(out) ::
+     &     intrsct_lat, intrsct_lon ! lat/lon coords of next intersect.
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, next_n, cell, srch_corners, pole_loc
+
+      logical (kind=log_kind) :: loutside ! flags points outside grid
+
+      real (kind=dbl_kind) :: pi4, rns, ! north/south conversion
+     &     x1, x2,       ! local x variables for segment
+     &     y1, y2,       ! local y variables for segment
+     &     begx, begy,   ! beginning x,y variables for segment
+     &     endx, endy,   ! beginning x,y variables for segment
+     &     begsegx, begsegy,   ! beginning x,y variables for segment
+     &     grdx1, grdx2, ! local x variables for grid cell
+     &     grdy1, grdy2, ! local y variables for grid cell
+     &     vec1_y, vec1_x, ! vectors and cross products used
+     &     vec2_y, vec2_x, ! during grid search
+     &     cross_product, eps, ! eps=small offset away from intersect
+     &     s1, s2, determ,     ! variables used for linear solve to
+     &     mat1, mat2, mat3, mat4, rhs1, rhs2  ! find intersection
+
+      real (kind=dbl_kind), dimension(:,:), allocatable ::
+     &     srch_corner_x,  ! x of each corner of srch cells
+     &     srch_corner_y   ! y of each corner of srch cells
+
+      !***
+      !*** save last intersection to avoid roundoff during coord
+      !*** transformation
+      !***
+
+      logical (kind=log_kind), save :: luse_last = .false.
+
+      real (kind=dbl_kind), save :: 
+     &     intrsct_x, intrsct_y  ! x,y for intersection
+
+      !***
+      !*** variables necessary if segment manages to hit pole
+      !***
+
+      integer (kind=int_kind), save :: 
+     &     avoid_pole_count = 0  ! count attempts to avoid pole
+
+      real (kind=dbl_kind), save :: 
+     &     avoid_pole_offset = tiny  ! endpoint offset to avoid pole
+
+!-----------------------------------------------------------------------
+!
+!     initialize defaults, flags, etc.
+!
+!-----------------------------------------------------------------------
+
+      if (.not. lthresh) location = 0
+      lcoinc = .false.
+      intrsct_lat = endlat
+      intrsct_lon = endlon
+
+      loutside = .false.
+      s1 = zero
+
+!-----------------------------------------------------------------------
+!
+!     convert coordinates
+!
+!-----------------------------------------------------------------------
+
+      allocate(srch_corner_x(size(srch_corner_lat,DIM=1),
+     &                       size(srch_corner_lat,DIM=2)),
+     &         srch_corner_y(size(srch_corner_lat,DIM=1),
+     &                       size(srch_corner_lat,DIM=2)))
+
+      if (beglat > zero) then
+        pi4 = quart*pi
+        rns = one
+      else
+        pi4 = -quart*pi
+        rns = -one
+      endif
+
+      if (luse_last) then
+        x1 = intrsct_x
+        y1 = intrsct_y
+      else
+        x1 = rns*two*sin(pi4 - half*beglat)*cos(beglon)
+        y1 =     two*sin(pi4 - half*beglat)*sin(beglon)
+        luse_last = .true.
+      endif
+      x2 = rns*two*sin(pi4 - half*endlat)*cos(endlon)
+      y2 =     two*sin(pi4 - half*endlat)*sin(endlon)
+      srch_corner_x = rns*two*sin(pi4 - half*srch_corner_lat)*
+     &                        cos(srch_corner_lon)
+      srch_corner_y =     two*sin(pi4 - half*srch_corner_lat)*
+     &                        sin(srch_corner_lon)
+
+      begx = x1
+      begy = y1
+      endx = x2
+      endy = y2
+      begsegx = rns*two*sin(pi4 - half*begseg(1))*cos(begseg(2))
+      begsegy =     two*sin(pi4 - half*begseg(1))*sin(begseg(2))
+      intrsct_x = endx
+      intrsct_y = endy
+
+!-----------------------------------------------------------------------
+!
+!     search for location of this segment in ocean grid using cross
+!     product method to determine whether a point is enclosed by a cell
+!
+!-----------------------------------------------------------------------
+
+      call timer_start(12)
+      srch_corners = size(srch_corner_lat,DIM=1)
+      srch_loop: do
+
+        !***
+        !*** if last segment crossed threshold, use that location
+        !***
+
+        if (lthresh) then
+          do cell=1,num_srch_cells
+            if (srch_add(cell) == location) then
+              eps = tiny
+              exit srch_loop
+            endif
+          end do
+        endif
+
+        !***
+        !*** otherwise normal search algorithm
+        !***
+
+        cell_loop: do cell=1,num_srch_cells
+          corner_loop: do n=1,srch_corners
+            next_n = MOD(n,srch_corners) + 1
+
+            !***
+            !*** here we take the cross product of the vector making 
+            !*** up each cell side with the vector formed by the vertex
+            !*** and search point.  if all the cross products are 
+            !*** positive, the point is contained in the cell.
+            !***
+
+            vec1_x = srch_corner_x(next_n,cell) - 
+     &               srch_corner_x(n     ,cell)
+            vec1_y = srch_corner_y(next_n,cell) - 
+     &               srch_corner_y(n     ,cell)
+            vec2_x = x1 - srch_corner_x(n,cell)
+            vec2_y = y1 - srch_corner_y(n,cell)
+
+            !***
+            !*** if endpoint coincident with vertex, offset
+            !*** the endpoint
+            !***
+
+            if (vec2_x == 0 .and. vec2_y == 0) then
+              x1 = x1 + 1.d-10*(x2-x1)
+              y1 = y1 + 1.d-10*(y2-y1)
+              vec2_x = x1 - srch_corner_x(n,cell)
+              vec2_y = y1 - srch_corner_y(n,cell)
+            endif
+
+            cross_product = vec1_x*vec2_y - vec2_x*vec1_y
+
+            !***
+            !*** if the cross product for a side is zero, the point 
+            !***   lies exactly on the side or the length of a side
+            !***   is zero.  if the length is zero set det > 0.
+            !***   otherwise, perform another cross 
+            !***   product between the side and the segment itself. 
+            !*** if this cross product is also zero, the line is 
+            !***   coincident with the cell boundary - perform the 
+            !***   dot product and only choose the cell if the dot 
+            !***   product is positive (parallel vs anti-parallel).
+            !***
+
+            if (cross_product == zero) then
+              if (vec1_x /= zero .or. vec1_y /= 0) then
+                vec2_x = x2 - x1
+                vec2_y = y2 - y1
+                cross_product = vec1_x*vec2_y - vec2_x*vec1_y
+              else
+                cross_product = one
+              endif
+
+              if (cross_product == zero) then
+                lcoinc = .true.
+                cross_product = vec1_x*vec2_x + vec1_y*vec2_y
+                if (lrevers) cross_product = -cross_product
+              endif
+            endif
+
+            !***
+            !*** if cross product is less than zero, this cell
+            !*** doesn't work
+            !***
+
+            if (cross_product < zero) exit corner_loop
+
+          end do corner_loop
+
+          !***
+          !*** if cross products all positive, we found the location
+          !***
+
+          if (n > srch_corners) then
+            location = srch_add(cell)
+
+            !***
+            !*** if the beginning of this segment was outside the
+            !*** grid, invert the segment so the intersection found
+            !*** will be the first intersection with the grid
+            !***
+
+            if (loutside) then
+              x2 = begx
+              y2 = begy
+              location = 0
+              eps  = -tiny
+            else
+              eps  = tiny
+            endif
+
+            exit srch_loop
+          endif
+
+          !***
+          !*** otherwise move on to next cell
+          !***
+
+        end do cell_loop
+
+        !***
+        !*** if no cell found, the point lies outside the grid.
+        !***   take some baby steps along the segment to see if any
+        !***   part of the segment lies inside the grid.  
+        !***
+
+        loutside = .true.
+        s1 = s1 + 0.001_dbl_kind
+        x1 = begx + s1*(x2 - begx)
+        y1 = begy + s1*(y2 - begy)
+
+        !***
+        !*** reached the end of the segment and still outside the grid
+        !*** return no intersection
+        !***
+
+        if (s1 >= one) then
+          deallocate(srch_corner_x, srch_corner_y)
+          luse_last = .false.
+          return
+        endif
+
+      end do srch_loop
+      call timer_stop(12)
+
+!-----------------------------------------------------------------------
+!
+!     now that a cell is found, search for the next intersection.
+!     loop over sides of the cell to find intersection with side
+!     must check all sides for coincidences or intersections
+!
+!-----------------------------------------------------------------------
+
+      call timer_start(13)
+      intrsct_loop: do n=1,srch_corners
+        next_n = mod(n,srch_corners) + 1
+
+        grdy1 = srch_corner_y(n     ,cell)
+        grdy2 = srch_corner_y(next_n,cell)
+        grdx1 = srch_corner_x(n     ,cell)
+        grdx2 = srch_corner_x(next_n,cell)
+
+        !***
+        !*** set up linear system to solve for intersection
+        !***
+
+        mat1 = x2 - x1
+        mat2 = grdx1 - grdx2
+        mat3 = y2 - y1
+        mat4 = grdy1 - grdy2
+        rhs1 = grdx1 - x1
+        rhs2 = grdy1 - y1
+
+        determ = mat1*mat4 - mat2*mat3
+
+        !***
+        !*** if the determinant is zero, the segments are either 
+        !***   parallel or coincident or one segment has zero length.  
+        !***   coincidences were detected above so do nothing.
+        !*** if the determinant is non-zero, solve for the linear 
+        !***   parameters s for the intersection point on each line 
+        !***   segment.
+        !*** if 0<s1,s2<1 then the segment intersects with this side.
+        !***   return the point of intersection (adding a small
+        !***   number so the intersection is off the grid line).
+        !***
+
+        if (abs(determ) > 1.e-30) then
+
+          s1 = (rhs1*mat4 - mat2*rhs2)/determ
+          s2 = (mat1*rhs2 - rhs1*mat3)/determ
+
+          if (s2 >= zero .and. s2 <= one .and.
+     &        s1 >  zero. and. s1 <= one) then
+
+            !***
+            !*** recompute intersection using entire segment
+            !*** for consistency between sweeps
+            !***
+
+            if (.not. loutside) then
+              mat1 = x2 - begsegx
+              mat3 = y2 - begsegy
+              rhs1 = grdx1 - begsegx
+              rhs2 = grdy1 - begsegy
+            else 
+              mat1 = x2 - endx
+              mat3 = y2 - endy
+              rhs1 = grdx1 - endx
+              rhs2 = grdy1 - endy
+            endif
+
+            determ = mat1*mat4 - mat2*mat3
+
+            !***
+            !*** sometimes due to roundoff, the previous 
+            !*** determinant is non-zero, but the lines
+            !*** are actually coincident.  if this is the
+            !*** case, skip the rest.
+            !***
+
+            if (determ /= zero) then
+              s1 = (rhs1*mat4 - mat2*rhs2)/determ
+              s2 = (mat1*rhs2 - rhs1*mat3)/determ
+
+              if (.not. loutside) then
+                intrsct_x = begsegx + s1*mat1
+                intrsct_y = begsegy + s1*mat3
+              else 
+                intrsct_x = endx + s1*mat1
+                intrsct_y = endy + s1*mat3
+              endif
+
+              !***
+              !*** convert back to lat/lon coordinates
+              !***
+
+              intrsct_lon = rns*atan2(intrsct_y,intrsct_x)
+              if (intrsct_lon < zero) 
+     &          intrsct_lon = intrsct_lon + pi2
+
+              if (abs(intrsct_x) > 1.d-10) then
+                intrsct_lat = (pi4 - 
+     &            asin(rns*half*intrsct_x/cos(intrsct_lon)))*two
+              else if (abs(intrsct_y) > 1.d-10) then
+                intrsct_lat = (pi4 - 
+     &            asin(half*intrsct_y/sin(intrsct_lon)))*two
+              else
+                intrsct_lat = two*pi4
+              endif
+
+              !***
+              !*** add offset in transformed space for next pass.
+              !***
+
+              if (s1 - eps/determ < one) then
+                intrsct_x = intrsct_x - mat1*(eps/determ)
+                intrsct_y = intrsct_y - mat3*(eps/determ)
+              else
+                if (.not. loutside) then
+                  intrsct_x = endx
+                  intrsct_y = endy
+                  intrsct_lat = endlat
+                  intrsct_lon = endlon
+                else 
+                  intrsct_x = begsegx
+                  intrsct_y = begsegy
+                  intrsct_lat = begseg(1)
+                  intrsct_lon = begseg(2)
+                endif
+              endif
+
+              exit intrsct_loop
+            endif
+          endif
+        endif
+
+        !***
+        !*** no intersection this side, move on to next side
+        !***
+
+      end do intrsct_loop
+      call timer_stop(13)
+
+      deallocate(srch_corner_x, srch_corner_y)
+
+!-----------------------------------------------------------------------
+!
+!     if segment manages to cross over pole, shift the beginning 
+!     endpoint in order to avoid hitting pole directly
+!     (it is ok for endpoint to be pole point)
+!
+!-----------------------------------------------------------------------
+
+      if (abs(intrsct_x) < 1.e-10 .and. abs(intrsct_y) < 1.e-10 .and.
+     &    (endx /= zero .and. endy /=0)) then
+        if (avoid_pole_count > 2) then
+           avoid_pole_count = 0
+           avoid_pole_offset = 10.*avoid_pole_offset
+        endif
+
+        cross_product = begsegx*(endy-begsegy) - begsegy*(endx-begsegx)
+        intrsct_lat = begseg(1)
+        if (cross_product*intrsct_lat > zero) then
+          intrsct_lon = beglon    + avoid_pole_offset
+          begseg(2)   = begseg(2) + avoid_pole_offset
+        else
+          intrsct_lon = beglon    - avoid_pole_offset
+          begseg(2)   = begseg(2) - avoid_pole_offset
+        endif
+
+        avoid_pole_count = avoid_pole_count + 1
+        luse_last = .false.
+      else
+        avoid_pole_count = 0
+        avoid_pole_offset = tiny
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     if the segment crosses a pole threshold, reset the intersection
+!     to be the threshold latitude and do not reuse x,y intersect
+!     on next entry.  only check if did not cross threshold last
+!     time - sometimes the coordinate transformation can place a
+!     segment on the other side of the threshold again
+!
+!-----------------------------------------------------------------------
+
+      if (lthresh) then
+        if (intrsct_lat > north_thresh .or. intrsct_lat < south_thresh)
+     &    lthresh = .false.
+      else if (beglat > zero .and. intrsct_lat < north_thresh) then
+        mat4 = endlat - begseg(1)
+        mat3 = endlon - begseg(2)
+        if (mat3 >  pi) mat3 = mat3 - pi2
+        if (mat3 < -pi) mat3 = mat3 + pi2
+        intrsct_lat = north_thresh - tiny
+        s1 = (north_thresh - begseg(1))/mat4
+        intrsct_lon = begseg(2) + s1*mat3
+        luse_last = .false.
+        lthresh = .true.
+      else if (beglat < zero .and. intrsct_lat > south_thresh) then
+        mat4 = endlat - begseg(1)
+        mat3 = endlon - begseg(2)
+        if (mat3 >  pi) mat3 = mat3 - pi2
+        if (mat3 < -pi) mat3 = mat3 + pi2
+        intrsct_lat = south_thresh + tiny
+        s1 = (south_thresh - begseg(1))/mat4
+        intrsct_lon = begseg(2) + s1*mat3
+        luse_last = .false.
+        lthresh = .true.
+      endif
+
+      !***
+      !*** if reached end of segment, do not use x,y intersect 
+      !*** on next entry
+      !***
+
+      if (intrsct_lat == endlat .and. intrsct_lon == endlon) then
+        luse_last = .false.
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine pole_intersection
+
+!***********************************************************************
+
+      subroutine line_integral(weights, num_wts, 
+     &                       in_phi1, in_phi2, theta1, theta2,
+     &                       grid1_lat, grid1_lon, grid2_lat, grid2_lon)
+
+!-----------------------------------------------------------------------
+!
+!     this routine computes the line integral of the flux function 
+!     that results in the interpolation weights.  the line is defined
+!     by the input lat/lon of the endpoints.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     intent(in):
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::
+     &        num_wts  ! number of weights to compute
+
+      real (kind=dbl_kind), intent(in) :: 
+     &     in_phi1, in_phi2,     ! longitude endpoints for the segment
+     &     theta1, theta2,       ! latitude  endpoints for the segment
+     &     grid1_lat, grid1_lon, ! reference coordinates for each
+     &     grid2_lat, grid2_lon  ! grid (to ensure correct 0,2pi interv.
+
+!-----------------------------------------------------------------------
+!
+!     intent(out):
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), dimension(2*num_wts), intent(out) ::
+     &     weights   ! line integral contribution to weights
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind) :: dphi, sinth1, sinth2, costh1, costh2, fac,
+     &                        phi1, phi2, phidiff1, phidiff2, sinint
+      real (kind=dbl_kind) :: f1, f2, fint
+
+!-----------------------------------------------------------------------
+!
+!     weights for the general case based on a trapezoidal approx to
+!     the integrals.
+!
+!-----------------------------------------------------------------------
+
+      sinth1 = SIN(theta1)
+      sinth2 = SIN(theta2)
+      costh1 = COS(theta1)
+      costh2 = COS(theta2)
+
+      dphi = in_phi1 - in_phi2
+      if (dphi >  pi) then
+        dphi = dphi - pi2
+      else if (dphi < -pi) then
+        dphi = dphi + pi2
+      endif
+      dphi = half*dphi
+
+!-----------------------------------------------------------------------
+!
+!     the first weight is the area overlap integral. the second and
+!     fourth are second-order latitude gradient weights.
+!
+!-----------------------------------------------------------------------
+
+      weights(        1) = dphi*(sinth1 + sinth2)
+      weights(num_wts+1) = dphi*(sinth1 + sinth2)
+      weights(        2) = dphi*(costh1 + costh2 + (theta1*sinth1 +
+     &                                              theta2*sinth2))
+      weights(num_wts+2) = dphi*(costh1 + costh2 + (theta1*sinth1 +
+     &                                              theta2*sinth2))
+
+!-----------------------------------------------------------------------
+!
+!     the third and fifth weights are for the second-order phi gradient
+!     component.  must be careful of longitude range.
+!
+!-----------------------------------------------------------------------
+
+      f1 = half*(costh1*sinth1 + theta1)
+      f2 = half*(costh2*sinth2 + theta2)
+
+      phi1 = in_phi1 - grid1_lon
+      if (phi1 >  pi) then
+        phi1 = phi1 - pi2
+      else if (phi1 < -pi) then
+        phi1 = phi1 + pi2
+      endif
+
+      phi2 = in_phi2 - grid1_lon
+      if (phi2 >  pi) then
+        phi2 = phi2 - pi2
+      else if (phi2 < -pi) then
+        phi2 = phi2 + pi2
+      endif
+
+      if ((phi2-phi1) <  pi .and. (phi2-phi1) > -pi) then
+        weights(3) = dphi*(phi1*f1 + phi2*f2)
+      else
+        if (phi1 > zero) then
+          fac = pi
+        else
+          fac = -pi
+        endif
+        fint = f1 + (f2-f1)*(fac-phi1)/abs(dphi)
+        weights(3) = half*phi1*(phi1-fac)*f1 -
+     &               half*phi2*(phi2+fac)*f2 +
+     &               half*fac*(phi1+phi2)*fint
+      endif
+
+      phi1 = in_phi1 - grid2_lon
+      if (phi1 >  pi) then
+        phi1 = phi1 - pi2
+      else if (phi1 < -pi) then
+        phi1 = phi1 + pi2
+      endif
+
+      phi2 = in_phi2 - grid2_lon
+      if (phi2 >  pi) then
+        phi2 = phi2 - pi2
+      else if (phi2 < -pi) then
+        phi2 = phi2 + pi2
+      endif
+
+      if ((phi2-phi1) <  pi .and. (phi2-phi1) > -pi) then
+        weights(num_wts+3) = dphi*(phi1*f1 + phi2*f2)
+      else
+        if (phi1 > zero) then
+          fac = pi
+        else
+          fac = -pi
+        endif
+        fint = f1 + (f2-f1)*(fac-phi1)/abs(dphi)
+        weights(num_wts+3) = half*phi1*(phi1-fac)*f1 -
+     &                       half*phi2*(phi2+fac)*f2 +
+     &                       half*fac*(phi1+phi2)*fint
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine line_integral
+
+!***********************************************************************
+
+      subroutine store_link_cnsrv(add1, add2, weights)
+
+!-----------------------------------------------------------------------
+!
+!     this routine stores the address and weight for this link in
+!     the appropriate address and weight arrays and resizes those
+!     arrays if necessary.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::
+     &        add1,  ! address on grid1
+     &        add2   ! address on grid2
+
+      real (kind=dbl_kind), dimension(:), intent(in) ::
+     &        weights ! array of remapping weights for this link
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: nlink, min_link, max_link ! link index
+
+      integer (kind=int_kind), dimension(:,:), allocatable, save ::
+     &        link_add1,  ! min,max link add to restrict search
+     &        link_add2   ! min,max link add to restrict search
+
+      logical (kind=log_kind), save :: first_call = .true.
+
+!-----------------------------------------------------------------------
+!
+!     if all weights are zero, do not bother storing the link
+!
+!-----------------------------------------------------------------------
+
+      if (all(weights == zero)) return
+
+!-----------------------------------------------------------------------
+!
+!     restrict the range of links to search for existing links
+!
+!-----------------------------------------------------------------------
+
+      if (first_call) then
+        allocate(link_add1(2,grid1_size), link_add2(2,grid2_size))
+        link_add1 = 0
+        link_add2 = 0
+        first_call = .false.
+        min_link = 1
+        max_link = 0
+      else
+        min_link = min(link_add1(1,add1),link_add2(1,add2))
+        max_link = max(link_add1(2,add1),link_add2(2,add2))
+        if (min_link == 0) then
+          min_link = 1
+          max_link = 0
+        endif
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     if the link already exists, add the weight to the current weight
+!     arrays
+!
+!-----------------------------------------------------------------------
+
+      do nlink=min_link,max_link
+        if (add1 == grid1_add_map1(nlink)) then
+        if (add2 == grid2_add_map1(nlink)) then
+
+          wts_map1(:,nlink) = wts_map1(:,nlink) + weights(1:num_wts)
+          if (num_maps == 2) then
+            wts_map2(:,nlink) = wts_map2(:,nlink) + 
+     &                                  weights(num_wts+1:2*num_wts)
+          endif
+          return
+
+        endif
+        endif
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     if the link does not yet exist, increment number of links and 
+!     check to see if remap arrays need to be increased to accomodate 
+!     the new link.  then store the link.
+!
+!-----------------------------------------------------------------------
+
+      num_links_map1  = num_links_map1 + 1
+      if (num_links_map1 > max_links_map1) 
+     &   call resize_remap_vars(1,resize_increment)
+
+      grid1_add_map1(num_links_map1) = add1
+      grid2_add_map1(num_links_map1) = add2
+      wts_map1    (:,num_links_map1) = weights(1:num_wts)
+
+      if (num_maps > 1) then
+        num_links_map2  = num_links_map2 + 1
+        if (num_links_map2 > max_links_map2) 
+     &     call resize_remap_vars(2,resize_increment)
+
+        grid1_add_map2(num_links_map2) = add1
+        grid2_add_map2(num_links_map2) = add2
+        wts_map2    (:,num_links_map2) = weights(num_wts+1:2*num_wts)
+      endif
+
+      if (link_add1(1,add1) == 0) link_add1(1,add1) = num_links_map1
+      if (link_add2(1,add2) == 0) link_add2(1,add2) = num_links_map1
+      link_add1(2,add1) = num_links_map1
+      link_add2(2,add2) = num_links_map1
+
+!-----------------------------------------------------------------------
+
+      end subroutine store_link_cnsrv
+
+!***********************************************************************
+
+      end module remap_conservative
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_distwgt.f
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_distwgt.f	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_distwgt.f	(revision 2352)
@@ -0,0 +1,498 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary routines for performing an 
+!     interpolation using a distance-weighted average of n nearest
+!     neighbors.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_distwgt.f,v 1.3 2000/04/19 21:56:26 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_distance_weight
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common constants
+      use grids         ! module containing grid info
+      use remap_vars    ! module containing remap info
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter :: 
+     &     num_neighbors=4  ! num nearest neighbors to interpolate from
+
+      real (kind=dbl_kind), dimension(:), allocatable, save ::
+     &     coslat, sinlat, ! cosine, sine of grid lats (for distance)
+     &     coslon, sinlon, ! cosine, sine of grid lons (for distance)
+     &     wgtstmp         ! an array to hold the link weight
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap_distwgt
+
+!-----------------------------------------------------------------------
+!
+!     this routine computes the inverse-distance weights for a
+!     nearest-neighbor interpolation.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      logical (kind=log_kind), dimension(num_neighbors) ::
+     &     nbr_mask        ! mask at nearest neighbors
+
+      integer (kind=int_kind) :: n,
+     &     dst_add,        ! destination address
+     &     nmap            ! index of current map being computed
+
+      integer (kind=int_kind), dimension(num_neighbors) ::
+     &     nbr_add         ! source address at nearest neighbors
+
+      real (kind=dbl_kind), dimension(num_neighbors) ::
+     &     nbr_dist        ! angular distance four nearest neighbors
+
+      real (kind=dbl_kind) ::
+     &     coslat_dst,     ! cos(lat) of destination grid point
+     &     coslon_dst,     ! cos(lon) of destination grid point
+     &     sinlat_dst,     ! sin(lat) of destination grid point
+     &     sinlon_dst,     ! sin(lon) of destination grid point
+     &     dist_tot        ! sum of neighbor distances (for normalizing)
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid1 to grid2
+!
+!-----------------------------------------------------------------------
+
+      nmap = 1
+
+      !***
+      !*** allocate wgtstmp to be consistent with store_link interface
+      !***
+
+      allocate (wgtstmp(num_wts))
+
+      !***
+      !*** compute cos, sin of lat/lon on source grid for distance
+      !*** calculations
+      !***
+
+      allocate (coslat(grid1_size), coslon(grid1_size),
+     &          sinlat(grid1_size), sinlon(grid1_size))
+
+      coslat = cos(grid1_center_lat)
+      coslon = cos(grid1_center_lon)
+      sinlat = sin(grid1_center_lat)
+      sinlon = sin(grid1_center_lon)
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop1: do dst_add = 1, grid2_size
+
+        if (.not. grid2_mask(dst_add)) cycle grid_loop1
+
+        coslat_dst = cos(grid2_center_lat(dst_add))
+        coslon_dst = cos(grid2_center_lon(dst_add))
+        sinlat_dst = sin(grid2_center_lat(dst_add))
+        sinlon_dst = sin(grid2_center_lon(dst_add))
+
+        !***
+        !*** find nearest grid points on source grid and
+        !*** distances to each point
+        !***
+
+        call grid_search_nbr(nbr_add, nbr_dist, 
+     &                       grid2_center_lat(dst_add),
+     &                       grid2_center_lon(dst_add),
+     &                       coslat_dst, coslon_dst, 
+     &                       sinlat_dst, sinlon_dst,
+     &                       bin_addr1, bin_addr2)
+
+        !***
+        !*** compute weights based on inverse distance
+        !*** if mask is false, eliminate those points
+        !***
+
+        dist_tot = zero
+        do n=1,num_neighbors
+          if (grid1_mask(nbr_add(n))) then
+            nbr_dist(n) = one/nbr_dist(n)
+            dist_tot = dist_tot + nbr_dist(n)
+            nbr_mask(n) = .true.
+          else
+            nbr_mask(n) = .false.
+          endif
+        end do
+
+        !***
+        !*** normalize weights and store the link
+        !***
+
+        do n=1,num_neighbors
+          if (nbr_mask(n)) then
+            wgtstmp(1) = nbr_dist(n)/dist_tot
+            call store_link_nbr(nbr_add(n), dst_add, wgtstmp, nmap)
+            grid2_frac(dst_add) = one
+          endif
+        end do
+
+      end do grid_loop1
+
+      deallocate (coslat, coslon, sinlat, sinlon)
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid2 to grid1 if necessary
+!
+!-----------------------------------------------------------------------
+
+      if (num_maps > 1) then
+
+      nmap = 2
+
+      !***
+      !*** compute cos, sin of lat/lon on source grid for distance
+      !*** calculations
+      !***
+
+      allocate (coslat(grid2_size), coslon(grid2_size),
+     &          sinlat(grid2_size), sinlon(grid2_size))
+
+      coslat = cos(grid2_center_lat)
+      coslon = cos(grid2_center_lon)
+      sinlat = sin(grid2_center_lat)
+      sinlon = sin(grid2_center_lon)
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop2: do dst_add = 1, grid1_size
+
+        if (.not. grid1_mask(dst_add)) cycle grid_loop2
+
+        coslat_dst = cos(grid1_center_lat(dst_add))
+        coslon_dst = cos(grid1_center_lon(dst_add))
+        sinlat_dst = sin(grid1_center_lat(dst_add))
+        sinlon_dst = sin(grid1_center_lon(dst_add))
+
+        !***
+        !*** find four nearest grid points on source grid and
+        !*** distances to each point
+        !***
+
+        call grid_search_nbr(nbr_add, nbr_dist,
+     &                       grid1_center_lat(dst_add),
+     &                       grid1_center_lon(dst_add),
+     &                       coslat_dst, coslon_dst, 
+     &                       sinlat_dst, sinlon_dst,
+     &                       bin_addr2, bin_addr1)
+
+        !***
+        !*** compute weights based on inverse distance
+        !*** if mask is false, eliminate those points
+        !***
+
+        dist_tot = zero
+        do n=1,num_neighbors
+          if (grid2_mask(nbr_add(n))) then
+            nbr_dist(n) = one/nbr_dist(n)
+            dist_tot = dist_tot + nbr_dist(n)
+            nbr_mask(n) = .true.
+          else
+            nbr_mask(n) = .false.
+          endif
+        end do
+
+        !***
+        !*** normalize weights and store the link
+        !***
+
+        do n=1,num_neighbors
+          if (nbr_mask(n)) then
+            wgtstmp(1) = nbr_dist(n)/dist_tot
+            call store_link_nbr(dst_add, nbr_add(n), wgtstmp, nmap)
+            grid1_frac(dst_add) = one
+          endif
+        end do
+
+      end do grid_loop2
+
+      deallocate (coslat, coslon, sinlat, sinlon)
+
+      endif
+
+      deallocate(wgtstmp)
+
+!-----------------------------------------------------------------------
+
+      end subroutine remap_distwgt
+
+!***********************************************************************
+
+      subroutine grid_search_nbr(nbr_add, nbr_dist, plat, plon, 
+     &               coslat_dst, coslon_dst, sinlat_dst, sinlon_dst,
+     &               src_bin_add, dst_bin_add)
+
+!-----------------------------------------------------------------------
+!
+!     this routine finds the closest num_neighbor points to a search 
+!     point and computes a distance to each of the neighbors.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(num_neighbors), intent(out) ::
+     &        nbr_add  ! address of each of the closest points
+
+      real (kind=dbl_kind), dimension(num_neighbors), intent(out) ::
+     &        nbr_dist ! distance to each of the closest points
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(:,:), intent(in) ::
+     &        src_bin_add, ! search bins for restricting search
+     &        dst_bin_add   
+
+      real (kind=dbl_kind), intent(in) ::
+     &        plat,         ! latitude  of the search point
+     &        plon,         ! longitude of the search point
+     &        coslat_dst,   ! cos(lat)  of the search point
+     &        coslon_dst,   ! cos(lon)  of the search point
+     &        sinlat_dst,   ! sin(lat)  of the search point
+     &        sinlon_dst    ! sin(lon)  of the search point
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, nmax, nadd, nchk, ! dummy indices
+     &        min_add, max_add, nm1, np1, i, j, ip1, im1, jp1, jm1
+
+      real (kind=dbl_kind) ::
+     &        distance      ! angular distance
+
+!-----------------------------------------------------------------------
+!
+!     loop over source grid and find nearest neighbors
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** restrict the search using search bins
+      !*** expand the bins to catch neighbors
+      !***
+
+      select case (restrict_type)
+      case('latitude')
+
+        do n=1,num_srch_bins
+          if (plat >= bin_lats(1,n) .and. plat <= bin_lats(2,n)) then
+            min_add = src_bin_add(1,n)
+            max_add = src_bin_add(2,n)
+
+            nm1 = max(n-1,1)
+            np1 = min(n+1,num_srch_bins)
+
+            min_add = min(min_add,src_bin_add(1,nm1))
+            max_add = max(max_add,src_bin_add(2,nm1))
+            min_add = min(min_add,src_bin_add(1,np1))
+            max_add = max(max_add,src_bin_add(2,np1))
+          endif
+        end do
+
+      case('latlon')
+
+        n = 0
+        nmax = nint(sqrt(real(num_srch_bins)))
+        do j=1,nmax
+        jp1 = min(j+1,nmax)
+        jm1 = max(j-1,1)
+        do i=1,nmax
+          ip1 = min(i+1,nmax)
+          im1 = max(i-1,1)
+
+          n = n+1
+          if (plat >= bin_lats(1,n) .and. plat <= bin_lats(2,n) .and.
+     &        plon >= bin_lons(1,n) .and. plon <= bin_lons(3,n)) then
+            min_add = src_bin_add(1,n)
+            max_add = src_bin_add(2,n)
+
+            nm1 = (jm1-1)*nmax + im1
+            np1 = (jp1-1)*nmax + ip1
+            nm1 = max(nm1,1)
+            np1 = min(np1,num_srch_bins)
+
+            min_add = min(min_add,src_bin_add(1,nm1))
+            max_add = max(max_add,src_bin_add(2,nm1))
+            min_add = min(min_add,src_bin_add(1,np1))
+            max_add = max(max_add,src_bin_add(2,np1))
+          endif
+        end do
+        end do
+
+      end select
+
+      !***
+      !*** initialize distance and address arrays
+      !***
+
+      nbr_add = 0
+      nbr_dist = bignum
+
+      do nadd=min_add,max_add
+
+        !***
+        !*** find distance to this point
+        !***
+
+        distance = acos(sinlat_dst*sinlat(nadd) +
+     &                  coslat_dst*coslat(nadd)*
+     &                 (coslon_dst*coslon(nadd) +
+     &                  sinlon_dst*sinlon(nadd)) )
+
+        !***
+        !*** store the address and distance if this is one of the
+        !*** smallest four so far
+        !***
+
+        check_loop: do nchk=1,num_neighbors
+          if (distance .lt. nbr_dist(nchk)) then
+            do n=num_neighbors,nchk+1,-1
+              nbr_add(n) = nbr_add(n-1)
+              nbr_dist(n) = nbr_dist(n-1)
+            end do
+            nbr_add(nchk) = nadd
+            nbr_dist(nchk) = distance
+            exit check_loop
+          endif
+        end do check_loop
+
+      end do
+
+!-----------------------------------------------------------------------
+
+      end subroutine grid_search_nbr 
+
+!***********************************************************************
+
+      subroutine store_link_nbr(add1, add2, weights, nmap)
+
+!-----------------------------------------------------------------------
+!
+!     this routine stores the address and weight for this link in
+!     the appropriate address and weight arrays and resizes those
+!     arrays if necessary.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::
+     &        add1,  ! address on grid1
+     &        add2,  ! address on grid2
+     &        nmap   ! identifies which direction for mapping
+
+      real (kind=dbl_kind), dimension(:), intent(in) ::
+     &        weights ! array of remapping weights for this link
+
+!-----------------------------------------------------------------------
+!
+!     increment number of links and check to see if remap arrays need
+!     to be increased to accomodate the new link.  then store the
+!     link.
+!
+!-----------------------------------------------------------------------
+
+      select case (nmap)
+      case(1)
+
+        num_links_map1  = num_links_map1 + 1
+
+        if (num_links_map1 > max_links_map1) 
+     &     call resize_remap_vars(1,resize_increment)
+
+        grid1_add_map1(num_links_map1) = add1
+        grid2_add_map1(num_links_map1) = add2
+        wts_map1    (:,num_links_map1) = weights
+
+      case(2)
+
+        num_links_map2  = num_links_map2 + 1
+
+        if (num_links_map2 > max_links_map2) 
+     &     call resize_remap_vars(2,resize_increment)
+
+        grid1_add_map2(num_links_map2) = add1
+        grid2_add_map2(num_links_map2) = add2
+        wts_map2    (:,num_links_map2) = weights
+
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine store_link_nbr
+
+!***********************************************************************
+
+      end module remap_distance_weight
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_read.f
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_read.f	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_read.f	(revision 2352)
@@ -0,0 +1,1027 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This routine reads remapping information from files written
+!     by remap_setup.  If remapping in both directions are required,
+!     two input files must be specified.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_read.f,v 1.6 2000/04/19 21:56:26 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_read
+
+!-----------------------------------------------------------------------
+!
+!     contains routines for reading a remap file
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines useful constants
+      use grids         ! includes all grid information
+      use netcdf_mod    ! module with netcdf vars and utilities
+      use remap_vars    ! module for all required remapping variables
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!     various netCDF ids for files variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), private :: ! netCDF ids
+     &         ncstat, nc_file_id,
+     &         nc_srcgrdsize_id, nc_dstgrdsize_id,
+     &         nc_srcgrdcorn_id, nc_dstgrdcorn_id,
+     &         nc_srcgrdrank_id, nc_dstgrdrank_id,
+     &         nc_srcgrddims_id, nc_dstgrddims_id,
+     &         nc_numlinks_id, nc_numwgts_id, 
+     &         nc_srcgrdimask_id, nc_dstgrdimask_id,
+     &         nc_srcgrdcntrlat_id, nc_srcgrdcntrlon_id,
+     &         nc_srcgrdcrnrlat_id, nc_srcgrdcrnrlon_id,
+     &         nc_srcgrdarea_id, nc_srcgrdfrac_id,
+     &         nc_dstgrdcntrlat_id, nc_dstgrdcntrlon_id,
+     &         nc_dstgrdcrnrlat_id, nc_dstgrdcrnrlon_id,
+     &         nc_dstgrdarea_id, nc_dstgrdfrac_id,
+     &         nc_srcgrdadd_id, nc_dstgrdadd_id, nc_rmpmatrix_id
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine read_remap(map_name, interp_file)
+
+!-----------------------------------------------------------------------
+!
+!     this driver routine reads some global attributes and then
+!     calls a specific read routine based on file conventions
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(in) ::
+     &  interp_file        ! filename for remap data
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(out) ::
+     &  map_name            ! name for mapping
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len) :: 
+     &   map_method       ! character string for map_type
+     &,  normalize_opt    ! character string for normalization option
+     &,  convention       ! character string for output convention
+
+!-----------------------------------------------------------------------
+!
+!     open file and read some global information
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_open(interp_file, NF_NOWRITE, nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** map name
+      !***
+      map_name = ' '
+      ncstat = nf_get_att_text(nc_file_id, NF_GLOBAL, 'title',
+     &                         map_name)
+      call netcdf_error_handler(ncstat)
+
+      print *,'Reading remapping:',trim(map_name)
+      print *,'From file:',trim(interp_file)
+
+      !***
+      !*** normalization option
+      !***
+      normalize_opt = ' '
+      ncstat = nf_get_att_text(nc_file_id, NF_GLOBAL, 'normalization',
+     &                         normalize_opt)
+      call netcdf_error_handler(ncstat)
+
+      select case(normalize_opt)
+      case ('none')
+        norm_opt = norm_opt_none
+      case ('fracarea')
+        norm_opt = norm_opt_frcarea
+      case ('destarea')
+        norm_opt = norm_opt_dstarea
+      case default
+        print *,'normalize_opt = ',normalize_opt
+        stop 'Invalid normalization option'
+      end select
+
+      !***
+      !*** map method
+      !***
+      map_method = ' '
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'map_method',
+     &                          map_method)
+      call netcdf_error_handler(ncstat)
+
+      select case(map_method)
+      case('Conservative remapping')
+        map_type = map_type_conserv
+      case('Bilinear remapping')
+        map_type = map_type_bilinear
+      case('Distance weighted avg of nearest neighbors')
+        map_type = map_type_distwgt
+      case('Bicubic remapping')
+        map_type = map_type_bicubic
+      case default
+        print *,'map_type = ',map_method
+        stop 'Invalid Map Type'
+      end select
+
+      !***
+      !*** file convention
+      !***
+      convention = ' '
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'conventions',
+     &                          convention)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     call appropriate read routine based on output convention
+!
+!-----------------------------------------------------------------------
+
+      select case(convention)
+      case ('SCRIP')
+        call read_remap_scrip
+      case ('NCAR-CSM')
+        call read_remap_csm
+      case default
+        print *,'convention = ',convention
+        stop 'unknown output file convention'
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine read_remap
+
+!***********************************************************************
+
+      subroutine read_remap_scrip
+
+!-----------------------------------------------------------------------
+!
+!     the routine reads a netCDF file to extract remapping info
+!     in SCRIP format
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character (char_len) ::
+     &  grid1_name           ! grid name for source grid
+     &, grid2_name           ! grid name for dest   grid
+
+      integer (kind=int_kind) ::  
+     &  n                    ! dummy index
+
+      integer (kind=int_kind), dimension(:), allocatable ::
+     &  grid1_mask_int,      ! integer masks to determine
+     &  grid2_mask_int       ! cells that participate in map
+
+!-----------------------------------------------------------------------
+!
+!     read some additional global attributes
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** source and destination grid names
+      !***
+
+      grid1_name = ' '
+      grid2_name = ' '
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'source_grid',
+     &                          grid1_name)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'dest_grid',
+     &                          grid2_name)
+      call netcdf_error_handler(ncstat)
+
+      print *,' '
+      print *,'Remapping between:',trim(grid1_name)
+      print *,'and ',trim(grid2_name)
+      print *,' '
+
+!-----------------------------------------------------------------------
+!
+!     read dimension information
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_inq_dimid(nc_file_id, 'src_grid_size', 
+     &                      nc_srcgrdsize_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdsize_id, grid1_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'dst_grid_size', 
+     &                      nc_dstgrdsize_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdsize_id, grid2_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'src_grid_corners', 
+     &                      nc_srcgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdcorn_id, 
+     &                       grid1_corners)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'dst_grid_corners', 
+     &                      nc_dstgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdcorn_id, 
+     &                       grid2_corners)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'src_grid_rank', 
+     &                      nc_srcgrdrank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdrank_id, 
+     &                       grid1_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'dst_grid_rank', 
+     &                      nc_dstgrdrank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdrank_id, 
+     &                       grid2_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'num_links', 
+     &                      nc_numlinks_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_numlinks_id, 
+     &                       num_links_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'num_wgts', 
+     &                      nc_numwgts_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_numwgts_id, num_wts)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     allocate arrays
+!
+!-----------------------------------------------------------------------
+
+      allocate( grid1_dims      (grid1_rank),
+     &          grid1_center_lat(grid1_size), 
+     &          grid1_center_lon(grid1_size),
+     &          grid1_area      (grid1_size),
+     &          grid1_frac      (grid1_size),
+     &          grid1_mask      (grid1_size),
+     &          grid1_mask_int  (grid1_size),
+     &          grid1_corner_lat(grid1_corners, grid1_size),
+     &          grid1_corner_lon(grid1_corners, grid1_size) )
+
+      allocate( grid2_dims      (grid2_rank),
+     &          grid2_center_lat(grid2_size), 
+     &          grid2_center_lon(grid2_size),
+     &          grid2_area      (grid2_size),
+     &          grid2_frac      (grid2_size),
+     &          grid2_mask      (grid2_size),
+     &          grid2_mask_int  (grid2_size),
+     &          grid2_corner_lat(grid2_corners, grid2_size),
+     &          grid2_corner_lon(grid2_corners, grid2_size) )
+
+      allocate( grid1_add_map1(num_links_map1),
+     &          grid2_add_map1(num_links_map1),
+     &          wts_map1(num_wts,num_links_map1) )
+
+!-----------------------------------------------------------------------
+!
+!     get variable ids
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_dims', 
+     &                      nc_srcgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_imask', 
+     &                      nc_srcgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_center_lat', 
+     &                                   nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_center_lon', 
+     &                                   nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_corner_lat', 
+     &                                   nc_srcgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_corner_lon', 
+     &                                   nc_srcgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_area', 
+     &                                   nc_srcgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_frac', 
+     &                                   nc_srcgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_dims', 
+     &                      nc_dstgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_imask', 
+     &                      nc_dstgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_center_lat', 
+     &                                   nc_dstgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_center_lon', 
+     &                                   nc_dstgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_corner_lat', 
+     &                                   nc_dstgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_corner_lon', 
+     &                                   nc_dstgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_area', 
+     &                                   nc_dstgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_frac', 
+     &                                   nc_dstgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_address', 
+     &                                   nc_srcgrdadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_address', 
+     &                                   nc_dstgrdadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'remap_matrix', 
+     &                                   nc_rmpmatrix_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     read all variables
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrddims_id, 
+     &                        grid1_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrdimask_id, 
+     &                        grid1_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcntrlat_id, 
+     &                                       grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcntrlon_id, 
+     &                                       grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      grid1_units = ' '
+      ncstat = nf_get_att_text(nc_file_id, nc_srcgrdcntrlat_id, 'units',
+     &                         grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+        grid1_center_lat = grid1_center_lat*deg2rad
+        grid1_center_lon = grid1_center_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid1 center lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcrnrlat_id, 
+     &                                       grid1_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcrnrlon_id, 
+     &                                       grid1_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      grid1_units = ' '
+      ncstat = nf_get_att_text(nc_file_id, nc_srcgrdcrnrlat_id, 'units',
+     &                         grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+        grid1_corner_lat = grid1_corner_lat*deg2rad
+        grid1_corner_lon = grid1_corner_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid1 corner lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdarea_id, 
+     &                                       grid1_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdfrac_id, 
+     &                                       grid1_frac)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrddims_id, 
+     &                        grid2_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrdimask_id, 
+     &                        grid2_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcntrlat_id, 
+     &                                       grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcntrlon_id, 
+     &                                       grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      grid2_units = ' '
+      ncstat = nf_get_att_text(nc_file_id, nc_dstgrdcntrlat_id, 'units',
+     &                         grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+        grid2_center_lat = grid2_center_lat*deg2rad
+        grid2_center_lon = grid2_center_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid2 center lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcrnrlat_id, 
+     &                                       grid2_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcrnrlon_id, 
+     &                                       grid2_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      grid2_units = ' '
+      ncstat = nf_get_att_text(nc_file_id, nc_dstgrdcrnrlat_id, 'units',
+     &                         grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+        grid2_corner_lat = grid2_corner_lat*deg2rad
+        grid2_corner_lon = grid2_corner_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid2 corner lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdarea_id, 
+     &                                       grid2_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdfrac_id, 
+     &                                       grid2_frac)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrdadd_id, 
+     &                        grid1_add_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrdadd_id, 
+     &                        grid2_add_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_rmpmatrix_id, 
+     &                                       wts_map1)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     initialize logical mask 
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_mask_int == 1)
+        grid1_mask = .true.
+      elsewhere
+        grid1_mask = .false.
+      endwhere
+      where (grid2_mask_int == 1)
+        grid2_mask = .true.
+      elsewhere
+        grid2_mask = .false.
+      endwhere
+      deallocate(grid1_mask_int, grid2_mask_int)
+
+!-----------------------------------------------------------------------
+!
+!     close input file
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_close(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end subroutine read_remap_scrip
+
+!***********************************************************************
+
+      subroutine read_remap_csm
+
+!-----------------------------------------------------------------------
+!
+!     the routine reads a netCDF file to extract remapping info
+!     in NCAR-CSM format
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character (char_len) ::
+     &  grid1_name           ! grid name for source grid
+     &, grid2_name           ! grid name for dest   grid
+
+      integer (kind=int_kind) ::
+     &  nc_numwgts1_id    ! extra netCDF id for num_wgts > 1 
+     &, nc_rmpmatrix2_id  ! extra netCDF id for high-order remap matrix
+
+      real (kind=dbl_kind), dimension(:),allocatable ::
+     &  wts1              ! CSM wants single array for 1st-order wts
+
+      real (kind=dbl_kind), dimension(:,:),allocatable ::
+     &  wts2              ! write remaining weights in different array
+
+      integer (kind=int_kind) ::  
+     &  n                    ! dummy index
+
+      integer (kind=int_kind), dimension(:), allocatable ::
+     &  grid1_mask_int,      ! integer masks to determine
+     &  grid2_mask_int       ! cells that participate in map
+
+!-----------------------------------------------------------------------
+!
+!     read some additional global attributes
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** source and destination grid names
+      !***
+
+      grid1_name = ' '
+      grid2_name = ' '
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'domain_a',
+     &                          grid1_name)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'domain_b',
+     &                          grid2_name)
+      call netcdf_error_handler(ncstat)
+
+      print *,' '
+      print *,'Remapping between:',trim(grid1_name)
+      print *,'and ',trim(grid2_name)
+      print *,' '
+
+!-----------------------------------------------------------------------
+!
+!     read dimension information
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_inq_dimid(nc_file_id, 'n_a', nc_srcgrdsize_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdsize_id, grid1_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'n_b', nc_dstgrdsize_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdsize_id, grid2_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'nv_a', nc_srcgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdcorn_id, 
+     &                       grid1_corners)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'nv_b', nc_dstgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdcorn_id, 
+     &                       grid2_corners)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'src_grid_rank', 
+     &                      nc_srcgrdrank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdrank_id, 
+     &                       grid1_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'dst_grid_rank', 
+     &                      nc_dstgrdrank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdrank_id, 
+     &                       grid2_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'n_s', 
+     &                      nc_numlinks_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_numlinks_id, 
+     &                       num_links_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'num_wgts', 
+     &                      nc_numwgts_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_numwgts_id, num_wts)
+      call netcdf_error_handler(ncstat)
+
+      if (num_wts > 1) then
+        ncstat = nf_inq_dimid(nc_file_id, 'num_wgts1', 
+     &                        nc_numwgts1_id)
+        call netcdf_error_handler(ncstat)
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     allocate arrays
+!
+!-----------------------------------------------------------------------
+
+      allocate( grid1_dims      (grid1_rank),
+     &          grid1_center_lat(grid1_size), 
+     &          grid1_center_lon(grid1_size),
+     &          grid1_area      (grid1_size),
+     &          grid1_frac      (grid1_size),
+     &          grid1_mask      (grid1_size),
+     &          grid1_mask_int  (grid1_size),
+     &          grid1_corner_lat(grid1_corners, grid1_size),
+     &          grid1_corner_lon(grid1_corners, grid1_size) )
+
+      allocate( grid2_dims      (grid2_rank),
+     &          grid2_center_lat(grid2_size), 
+     &          grid2_center_lon(grid2_size),
+     &          grid2_area      (grid2_size),
+     &          grid2_frac      (grid2_size),
+     &          grid2_mask      (grid2_size),
+     &          grid2_mask_int  (grid2_size),
+     &          grid2_corner_lat(grid2_corners, grid2_size),
+     &          grid2_corner_lon(grid2_corners, grid2_size) )
+
+      allocate( grid1_add_map1(num_links_map1),
+     &          grid2_add_map1(num_links_map1),
+     &          wts_map1(num_wts,num_links_map1),
+     &          wts1(num_links_map1),
+     &          wts2(num_wts-1,num_links_map1) )
+
+!-----------------------------------------------------------------------
+!
+!     get variable ids
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_dims', 
+     &                      nc_srcgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'mask_a', 
+     &                      nc_srcgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'yc_a', nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'xc_a', nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'yv_a', nc_srcgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'xv_a', nc_srcgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'area_a', nc_srcgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'frac_a', nc_srcgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_dims', 
+     &                      nc_dstgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'mask_b', 
+     &                      nc_dstgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'yc_b', nc_dstgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'xc_b', nc_dstgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'yv_b', nc_dstgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'xv_b', nc_dstgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'area_b', nc_dstgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'frac_b', nc_dstgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'col', nc_srcgrdadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'row', nc_dstgrdadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'S', nc_rmpmatrix_id)
+      call netcdf_error_handler(ncstat)
+
+      if (num_wts > 1) then
+        ncstat = nf_inq_varid(nc_file_id, 'S2', nc_rmpmatrix2_id)
+        call netcdf_error_handler(ncstat)
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     read all variables
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrddims_id, 
+     &                        grid1_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrdimask_id, 
+     &                        grid1_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcntrlat_id, 
+     &                                       grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcntrlon_id, 
+     &                                       grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text(nc_file_id, nc_srcgrdcntrlat_id, 'units',
+     &                         grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+        grid1_center_lat = grid1_center_lat*deg2rad
+        grid1_center_lon = grid1_center_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid1 center lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcrnrlat_id, 
+     &                                       grid1_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcrnrlon_id, 
+     &                                       grid1_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text(nc_file_id, nc_srcgrdcrnrlat_id, 'units',
+     &                         grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+        grid1_corner_lat = grid1_corner_lat*deg2rad
+        grid1_corner_lon = grid1_corner_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid1 corner lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdarea_id, 
+     &                                       grid1_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdfrac_id, 
+     &                                       grid1_frac)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrddims_id, 
+     &                        grid2_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrdimask_id, 
+     &                        grid2_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcntrlat_id, 
+     &                                       grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcntrlon_id, 
+     &                                       grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text(nc_file_id, nc_dstgrdcntrlat_id, 'units',
+     &                         grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+        grid2_center_lat = grid2_center_lat*deg2rad
+        grid2_center_lon = grid2_center_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid2 center lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcrnrlat_id, 
+     &                                       grid2_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcrnrlon_id, 
+     &                                       grid2_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+
+      ncstat = nf_get_att_text(nc_file_id, nc_dstgrdcrnrlat_id, 'units',
+     &                         grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+        grid2_corner_lat = grid2_corner_lat*deg2rad
+        grid2_corner_lon = grid2_corner_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid2 corner lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdarea_id, 
+     &                                       grid2_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdfrac_id, 
+     &                                       grid2_frac)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrdadd_id, 
+     &                        grid1_add_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrdadd_id, 
+     &                        grid2_add_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_rmpmatrix_id, 
+     &                                       wts1)
+      wts_map1(1,:) = wts1
+      deallocate(wts1)
+
+      if (num_wts > 1) then
+        ncstat = nf_get_var_double(nc_file_id, nc_rmpmatrix2_id, 
+     &                                         wts2)
+        wts_map1(2:,:) = wts2
+        deallocate(wts2)
+      endif
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     initialize logical mask 
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_mask_int == 1)
+        grid1_mask = .true.
+      elsewhere
+        grid1_mask = .false.
+      endwhere
+      where (grid2_mask_int == 1)
+        grid2_mask = .true.
+      elsewhere
+        grid2_mask = .false.
+      endwhere
+      deallocate(grid1_mask_int, grid2_mask_int)
+
+!-----------------------------------------------------------------------
+!
+!     close input file
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_close(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end subroutine read_remap_csm
+
+!***********************************************************************
+
+      end module remap_read
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_vars.f
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_vars.f	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_vars.f	(revision 2352)
@@ -0,0 +1,302 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary variables for remapping between
+!     two grids.  also routines for resizing and initializing these
+!     variables.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_vars.f,v 1.5 2000/04/19 21:56:26 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_vars
+
+      use kinds_mod
+      use constants
+      use grids
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter ::
+     &      norm_opt_none    = 1
+     &,     norm_opt_dstarea = 2
+     &,     norm_opt_frcarea = 3
+
+      integer (kind=int_kind), parameter ::
+     &      map_type_conserv  = 1
+     &,     map_type_bilinear = 2
+     &,     map_type_bicubic  = 3
+     &,     map_type_distwgt  = 4
+
+      integer (kind=int_kind), save :: 
+     &      max_links_map1  ! current size of link arrays
+     &,     num_links_map1  ! actual number of links for remapping
+     &,     max_links_map2  ! current size of link arrays
+     &,     num_links_map2  ! actual number of links for remapping
+     &,     num_maps        ! num of remappings for this grid pair
+     &,     num_wts         ! num of weights used in remapping
+     &,     map_type        ! identifier for remapping method
+     &,     norm_opt        ! option for normalization (conserv only)
+     &,     resize_increment ! default amount to increase array size
+
+      integer (kind=int_kind), dimension(:), allocatable, save ::
+     &      grid1_add_map1, ! grid1 address for each link in mapping 1
+     &      grid2_add_map1, ! grid2 address for each link in mapping 1
+     &      grid1_add_map2, ! grid1 address for each link in mapping 2
+     &      grid2_add_map2  ! grid2 address for each link in mapping 2
+
+      real (kind=dbl_kind), dimension(:,:), allocatable, save ::
+     &      wts_map1, ! map weights for each link (num_wts,max_links)
+     &      wts_map2  ! map weights for each link (num_wts,max_links)
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine init_remap_vars
+
+!-----------------------------------------------------------------------
+!
+!     this routine initializes some variables and provides an initial
+!     allocation of arrays (fairly large so frequent resizing 
+!     unnecessary).
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     determine the number of weights
+!
+!-----------------------------------------------------------------------
+
+      select case (map_type)
+      case(map_type_conserv)
+        num_wts = 3
+      case(map_type_bilinear)
+        num_wts = 1
+      case(map_type_bicubic)
+        num_wts = 4
+      case(map_type_distwgt)
+        num_wts = 1
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     initialize num_links and set max_links to four times the largest 
+!     of the destination grid sizes initially (can be changed later).
+!     set a default resize increment to increase the size of link
+!     arrays if the number of links exceeds the initial size
+!   
+!-----------------------------------------------------------------------
+
+      num_links_map1 = 0
+      max_links_map1 = 4*grid2_size
+      if (num_maps > 1) then
+        num_links_map2 = 0
+        max_links_map1 = max(4*grid1_size,4*grid2_size)
+        max_links_map2 = max_links_map1
+      endif
+
+      resize_increment = 0.1*max(grid1_size,grid2_size)
+
+!-----------------------------------------------------------------------
+!
+!     allocate address and weight arrays for mapping 1
+!   
+!-----------------------------------------------------------------------
+
+      allocate (grid1_add_map1(max_links_map1),
+     &          grid2_add_map1(max_links_map1),
+     &          wts_map1(num_wts, max_links_map1))
+
+!-----------------------------------------------------------------------
+!
+!     allocate address and weight arrays for mapping 2 if necessary 
+!   
+!-----------------------------------------------------------------------
+
+      if (num_maps > 1) then
+        allocate (grid1_add_map2(max_links_map2),
+     &            grid2_add_map2(max_links_map2),
+     &            wts_map2(num_wts, max_links_map2))
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine init_remap_vars
+
+!***********************************************************************
+
+      subroutine resize_remap_vars(nmap, increment)
+
+!-----------------------------------------------------------------------
+!
+!     this routine resizes remapping arrays by increasing(decreasing)
+!     the max_links by increment
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::
+     &     nmap,      ! identifies which mapping array to resize
+     &     increment  ! the number of links to add(subtract) to arrays
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) ::
+     &   ierr,     ! error flag
+     &   mxlinks   ! size of link arrays
+
+      integer (kind=int_kind), dimension(:), allocatable ::
+     &   add1_tmp, ! temp array for resizing address arrays
+     &   add2_tmp  ! temp array for resizing address arrays
+
+      real (kind=dbl_kind), dimension(:,:), allocatable ::
+     &   wts_tmp   ! temp array for resizing weight arrays
+
+!-----------------------------------------------------------------------
+!
+!     resize map 1 arrays if required.
+!
+!-----------------------------------------------------------------------
+
+      select case (nmap)
+      case(1)
+
+        !***
+        !*** allocate temporaries to hold original values
+        !***
+
+        mxlinks = size(grid1_add_map1)
+        allocate (add1_tmp(mxlinks), add2_tmp(mxlinks), 
+     &            wts_tmp(num_wts,mxlinks))
+
+        add1_tmp = grid1_add_map1
+        add2_tmp = grid2_add_map1
+        wts_tmp  = wts_map1
+        
+        !***
+        !*** deallocate originals and increment max_links then
+        !*** reallocate arrays at new size
+        !***
+
+        deallocate (grid1_add_map1, grid2_add_map1, wts_map1)
+        max_links_map1 = mxlinks + increment
+        allocate (grid1_add_map1(max_links_map1),
+     &            grid2_add_map1(max_links_map1),
+     &            wts_map1(num_wts,max_links_map1))
+
+        !***
+        !*** restore original values from temp arrays and
+        !*** deallocate temps
+        !***
+
+        mxlinks = min(mxlinks, max_links_map1)
+        grid1_add_map1(1:mxlinks) = add1_tmp (1:mxlinks)
+        grid2_add_map1(1:mxlinks) = add2_tmp (1:mxlinks)
+        wts_map1    (:,1:mxlinks) = wts_tmp(:,1:mxlinks)
+        deallocate(add1_tmp, add2_tmp, wts_tmp)
+
+!-----------------------------------------------------------------------
+!
+!     resize map 2 arrays if required.
+!
+!-----------------------------------------------------------------------
+
+      case(2)
+
+        !***
+        !*** allocate temporaries to hold original values
+        !***
+
+        mxlinks = size(grid1_add_map2)
+        allocate (add1_tmp(mxlinks), add2_tmp(mxlinks), 
+     &            wts_tmp(num_wts,mxlinks),stat=ierr)
+        if (ierr .ne. 0) then
+          print *,'error allocating temps in resize: ',ierr
+          stop
+        endif
+
+        add1_tmp = grid1_add_map2
+        add2_tmp = grid2_add_map2
+        wts_tmp  = wts_map2
+        
+        !***
+        !*** deallocate originals and increment max_links then
+        !*** reallocate arrays at new size
+        !***
+
+        deallocate (grid1_add_map2, grid2_add_map2, wts_map2)
+        max_links_map2 = mxlinks + increment
+        allocate (grid1_add_map2(max_links_map2),
+     &            grid2_add_map2(max_links_map2),
+     &            wts_map2(num_wts,max_links_map2),stat=ierr)
+        if (ierr .ne. 0) then
+          print *,'error allocating new arrays in resize: ',ierr
+          stop
+        endif
+
+
+        !***
+        !*** restore original values from temp arrays and
+        !*** deallocate temps
+        !***
+
+        mxlinks = min(mxlinks, max_links_map2)
+        grid1_add_map2(1:mxlinks) = add1_tmp (1:mxlinks)
+        grid2_add_map2(1:mxlinks) = add2_tmp (1:mxlinks)
+        wts_map2    (:,1:mxlinks) = wts_tmp(:,1:mxlinks)
+        deallocate(add1_tmp, add2_tmp, wts_tmp)
+
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine resize_remap_vars
+
+!***********************************************************************
+
+      end module remap_vars
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_write.f
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_write.f	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_write.f	(revision 2352)
@@ -0,0 +1,1763 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module contains routines for writing the remapping data to 
+!     a file.  Before writing the data for each mapping, the links are 
+!     sorted by destination grid address.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_write.f,v 1.7 2001/08/21 21:06:42 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_write
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common scalar constants
+      use grids         ! module containing grid information
+      use remap_vars    ! module containing remap information
+      use netcdf_mod    ! module with netCDF stuff
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), private :: 
+     &   map_method       ! character string for map_type
+     &,  normalize_opt    ! character string for normalization option
+     &,  history          ! character string for history information
+     &,  convention       ! character string for output convention
+
+      character(8), private :: 
+     &   cdate            ! character date string
+
+      integer (kind=int_kind), dimension(:), allocatable, private ::
+     &   src_mask_int     ! integer masks to determine
+     &,  dst_mask_int     ! cells that participate in map
+
+!-----------------------------------------------------------------------
+!
+!     various netCDF identifiers used by output routines
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), private ::
+     &   ncstat               ! error flag for netCDF calls 
+     &,  nc_file_id           ! id for netCDF file
+     &,  nc_srcgrdsize_id     ! id for source grid size
+     &,  nc_dstgrdsize_id     ! id for destination grid size
+     &,  nc_srcgrdcorn_id     ! id for number of source grid corners
+     &,  nc_dstgrdcorn_id     ! id for number of dest grid corners
+     &,  nc_srcgrdrank_id     ! id for source grid rank
+     &,  nc_dstgrdrank_id     ! id for dest grid rank
+     &,  nc_numlinks_id       ! id for number of links in mapping
+     &,  nc_numwgts_id        ! id for number of weights for mapping
+     &,  nc_srcgrddims_id     ! id for source grid dimensions
+     &,  nc_dstgrddims_id     ! id for dest grid dimensions
+     &,  nc_srcgrdcntrlat_id  ! id for source grid center latitude
+     &,  nc_dstgrdcntrlat_id  ! id for dest grid center latitude
+     &,  nc_srcgrdcntrlon_id  ! id for source grid center longitude
+     &,  nc_dstgrdcntrlon_id  ! id for dest grid center longitude
+     &,  nc_srcgrdimask_id    ! id for source grid mask
+     &,  nc_dstgrdimask_id    ! id for dest grid mask
+     &,  nc_srcgrdcrnrlat_id  ! id for latitude of source grid corners
+     &,  nc_srcgrdcrnrlon_id  ! id for longitude of source grid corners
+     &,  nc_dstgrdcrnrlat_id  ! id for latitude of dest grid corners
+     &,  nc_dstgrdcrnrlon_id  ! id for longitude of dest grid corners
+     &,  nc_srcgrdarea_id     ! id for area of source grid cells
+     &,  nc_dstgrdarea_id     ! id for area of dest grid cells
+     &,  nc_srcgrdfrac_id     ! id for area fraction on source grid
+     &,  nc_dstgrdfrac_id     ! id for area fraction on dest grid
+     &,  nc_srcadd_id         ! id for map source address
+     &,  nc_dstadd_id         ! id for map destination address
+     &,  nc_rmpmatrix_id      ! id for remapping matrix
+
+      integer (kind=int_kind), dimension(2), private ::
+     &   nc_dims2_id  ! netCDF ids for 2d array dims
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine write_remap(map1_name, map2_name, 
+     &                       interp_file1, interp_file2, output_opt)
+
+!-----------------------------------------------------------------------
+!
+!     calls correct output routine based on output format choice
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(in) ::
+     &            map1_name,    ! name for mapping grid1 to grid2
+     &            map2_name,    ! name for mapping grid2 to grid1
+     &            interp_file1, ! filename for map1 remap data
+     &            interp_file2, ! filename for map2 remap data
+     &            output_opt    ! option for output conventions
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     define some common variables to be used in all routines
+!
+!-----------------------------------------------------------------------
+
+      select case(norm_opt)
+      case (norm_opt_none)
+        normalize_opt = 'none'
+      case (norm_opt_frcarea)
+        normalize_opt = 'fracarea'
+      case (norm_opt_dstarea)
+        normalize_opt = 'destarea'
+      end select
+
+      select case(map_type)
+      case(map_type_conserv)
+        map_method = 'Conservative remapping'
+      case(map_type_bilinear)
+        map_method = 'Bilinear remapping'
+      case(map_type_distwgt)
+        map_method = 'Distance weighted avg of nearest neighbors'
+      case(map_type_bicubic)
+        map_method = 'Bicubic remapping'
+      case default
+        stop 'Invalid Map Type'
+      end select
+
+      call date_and_time(date=cdate)
+      write (history,1000) cdate(5:6),cdate(7:8),cdate(1:4)
+ 1000 format('Created: ',a2,'-',a2,'-',a4)
+
+!-----------------------------------------------------------------------
+!
+!     sort address and weight arrays
+!
+!-----------------------------------------------------------------------
+
+      call sort_add(grid2_add_map1, grid1_add_map1, wts_map1)
+      if (num_maps > 1) then
+        call sort_add(grid1_add_map2, grid2_add_map2, wts_map2)
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     call appropriate output routine
+!
+!-----------------------------------------------------------------------
+
+      select case(output_opt)
+      case ('scrip')
+        call write_remap_scrip(map1_name, interp_file1, 1)
+      case ('ncar-csm')
+        call write_remap_csm  (map1_name, interp_file1, 1)
+      case default
+        stop 'unknown output file convention'
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     call appropriate output routine for second mapping if required
+!
+!-----------------------------------------------------------------------
+
+      if (num_maps > 1) then
+        select case(output_opt)
+        case ('scrip')
+          call write_remap_scrip(map2_name, interp_file2, 2)
+        case ('ncar-csm')
+          call write_remap_csm  (map2_name, interp_file2, 2)
+        case default
+          stop 'unknown output file convention'
+        end select
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine write_remap
+
+!***********************************************************************
+
+      subroutine write_remap_scrip(map_name, interp_file, direction)
+
+!-----------------------------------------------------------------------
+!
+!     writes remap data to a netCDF file using SCRIP conventions
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(in) ::
+     &            map_name     ! name for mapping 
+     &,           interp_file  ! filename for remap data
+
+      integer (kind=int_kind), intent(in) ::
+     &  direction              ! direction of map (1=grid1 to grid2
+                               !                   2=grid2 to grid1)
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len) ::
+     &  grid1_ctmp        ! character temp for grid1 names
+     &, grid2_ctmp        ! character temp for grid2 names
+
+      integer (kind=int_kind) ::
+     &  itmp1             ! integer temp
+     &, itmp2             ! integer temp
+     &, itmp3             ! integer temp
+     &, itmp4             ! integer temp
+
+!-----------------------------------------------------------------------
+!
+!     create netCDF file for mapping and define some global attributes
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_create (interp_file, NF_CLOBBER, nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** map name
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'title',
+     &                          len_trim(map_name), map_name)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** normalization option
+      !***
+      ncstat = nf_put_att_text(nc_file_id, NF_GLOBAL, 'normalization',
+     &                         len_trim(normalize_opt), normalize_opt)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** map method
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'map_method',
+     &                          len_trim(map_method), map_method)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** history
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'history',
+     &                          len_trim(history), history)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** file convention
+      !***
+      convention = 'SCRIP'
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'conventions',
+     &                          len_trim(convention), convention)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** source and destination grid names
+      !***
+
+      if (direction == 1) then
+        grid1_ctmp = 'source_grid'
+        grid2_ctmp = 'dest_grid'
+      else
+        grid1_ctmp = 'dest_grid'
+        grid2_ctmp = 'source_grid'
+      endif
+
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, trim(grid1_ctmp),
+     &                          len_trim(grid1_name), grid1_name)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, trim(grid2_ctmp),
+     &                          len_trim(grid2_name), grid2_name)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     prepare netCDF dimension info
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** define grid size dimensions
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_size
+        itmp2 = grid2_size
+      else
+        itmp1 = grid2_size
+        itmp2 = grid1_size
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'src_grid_size', itmp1, 
+     &                     nc_srcgrdsize_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'dst_grid_size', itmp2, 
+     &                     nc_dstgrdsize_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner dimension
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_corners
+        itmp2 = grid2_corners
+      else
+        itmp1 = grid2_corners
+        itmp2 = grid1_corners
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'src_grid_corners', 
+     &                     itmp1, nc_srcgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'dst_grid_corners', 
+     &                     itmp2, nc_dstgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid rank dimension
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_rank
+        itmp2 = grid2_rank
+      else
+        itmp1 = grid2_rank
+        itmp2 = grid1_rank
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'src_grid_rank', 
+     &                     itmp1, nc_srcgrdrank_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'dst_grid_rank', 
+     &                     itmp2, nc_dstgrdrank_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define map size dimensions
+      !***
+
+      if (direction == 1) then
+        itmp1 = num_links_map1
+      else
+        itmp1 = num_links_map2
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'num_links', 
+     &                     itmp1, nc_numlinks_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'num_wgts', 
+     &                     num_wts, nc_numwgts_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid dimensions
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_dims', NF_INT,
+     &                     1, nc_srcgrdrank_id, nc_srcgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_dims', NF_INT,
+     &                     1, nc_dstgrdrank_id, nc_dstgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     define all arrays for netCDF descriptors
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** define grid center latitude array
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_center_lat', 
+     &                     NF_DOUBLE, 1, nc_srcgrdsize_id, 
+     &                     nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_center_lat', 
+     &                     NF_DOUBLE, 1, nc_dstgrdsize_id, 
+     &                     nc_dstgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center longitude array
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_center_lon', 
+     &                     NF_DOUBLE, 1, nc_srcgrdsize_id, 
+     &                     nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_center_lon', 
+     &                     NF_DOUBLE, 1, nc_dstgrdsize_id, 
+     &                     nc_dstgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner lat/lon arrays
+      !***
+
+      nc_dims2_id(1) = nc_srcgrdcorn_id
+      nc_dims2_id(2) = nc_srcgrdsize_id
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_corner_lat', 
+     &                     NF_DOUBLE, 2, nc_dims2_id, 
+     &                     nc_srcgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_corner_lon', 
+     &                     NF_DOUBLE, 2, nc_dims2_id, 
+     &                     nc_srcgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      nc_dims2_id(1) = nc_dstgrdcorn_id
+      nc_dims2_id(2) = nc_dstgrdsize_id
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_corner_lat', 
+     &                     NF_DOUBLE, 2, nc_dims2_id, 
+     &                     nc_dstgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_corner_lon', 
+     &                     NF_DOUBLE, 2, nc_dims2_id, 
+     &                     nc_dstgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define units for all coordinate arrays
+      !***
+
+      if (direction == 1) then
+        grid1_ctmp = grid1_units
+        grid2_ctmp = grid2_units
+      else
+        grid1_ctmp = grid2_units
+        grid2_ctmp = grid1_units
+      endif
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcntrlat_id, 
+     &                          'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcntrlat_id, 
+     &                          'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcntrlon_id, 
+     &                          'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcntrlon_id, 
+     &                          'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcrnrlat_id, 
+     &                          'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcrnrlon_id, 
+     &                          'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcrnrlat_id, 
+     &                          'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcrnrlon_id, 
+     &                          'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid mask
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_imask', NF_INT,
+     &                     1, nc_srcgrdsize_id, nc_srcgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdimask_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_imask', NF_INT,
+     &                     1, nc_dstgrdsize_id, nc_dstgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdimask_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid area arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_area', 
+     &                     NF_DOUBLE, 1, nc_srcgrdsize_id, 
+     &                     nc_srcgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdarea_id, 
+     &                          'units', 14, 'square radians')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_area', 
+     &                     NF_DOUBLE, 1, nc_dstgrdsize_id, 
+     &                     nc_dstgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdarea_id, 
+     &                          'units', 14, 'square radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid fraction arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_frac', 
+     &                     NF_DOUBLE, 1, nc_srcgrdsize_id, 
+     &                     nc_srcgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdfrac_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_frac', 
+     &                     NF_DOUBLE, 1, nc_dstgrdsize_id, 
+     &                     nc_dstgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdfrac_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define mapping arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_address', 
+     &                     NF_INT, 1, nc_numlinks_id, 
+     &                     nc_srcadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_address', 
+     &                     NF_INT, 1, nc_numlinks_id, 
+     &                     nc_dstadd_id)
+      call netcdf_error_handler(ncstat)
+
+      nc_dims2_id(1) = nc_numwgts_id
+      nc_dims2_id(2) = nc_numlinks_id
+
+      ncstat = nf_def_var (nc_file_id, 'remap_matrix', 
+     &                     NF_DOUBLE, 2, nc_dims2_id, 
+     &                     nc_rmpmatrix_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** end definition stage
+      !***
+
+      ncstat = nf_enddef(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     compute integer masks
+!
+!-----------------------------------------------------------------------
+
+      if (direction == 1) then
+        allocate (src_mask_int(grid1_size),
+     &            dst_mask_int(grid2_size))
+
+        where (grid2_mask)
+          dst_mask_int = 1
+        elsewhere
+          dst_mask_int = 0
+        endwhere
+
+        where (grid1_mask)
+          src_mask_int = 1
+        elsewhere
+          src_mask_int = 0
+        endwhere
+      else
+        allocate (src_mask_int(grid2_size),
+     &            dst_mask_int(grid1_size))
+
+        where (grid1_mask)
+          dst_mask_int = 1
+        elsewhere
+          dst_mask_int = 0
+        endwhere
+
+        where (grid2_mask)
+          src_mask_int = 1
+        elsewhere
+          src_mask_int = 0
+        endwhere
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     change units of lat/lon coordinates if input units different
+!     from radians
+!
+!-----------------------------------------------------------------------
+
+      if (grid1_units(1:7) == 'degrees' .and. direction == 1) then
+        grid1_center_lat = grid1_center_lat/deg2rad
+        grid1_center_lon = grid1_center_lon/deg2rad
+        grid1_corner_lat = grid1_corner_lat/deg2rad
+        grid1_corner_lon = grid1_corner_lon/deg2rad
+      endif
+
+      if (grid2_units(1:7) == 'degrees' .and. direction == 1) then
+        grid2_center_lat = grid2_center_lat/deg2rad
+        grid2_center_lon = grid2_center_lon/deg2rad
+        grid2_corner_lat = grid2_corner_lat/deg2rad
+        grid2_corner_lon = grid2_corner_lon/deg2rad
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     write mapping data
+!
+!-----------------------------------------------------------------------
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrddims_id
+        itmp2 = nc_dstgrddims_id
+      else
+        itmp2 = nc_srcgrddims_id
+        itmp1 = nc_dstgrddims_id
+      endif
+
+      ncstat = nf_put_var_int(nc_file_id, itmp1, grid1_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, itmp2, grid2_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, nc_srcgrdimask_id, 
+     &                        src_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, nc_dstgrdimask_id,
+     &                        dst_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      deallocate(src_mask_int, dst_mask_int)
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrdcntrlat_id
+        itmp2 = nc_srcgrdcntrlon_id
+        itmp3 = nc_srcgrdcrnrlat_id
+        itmp4 = nc_srcgrdcrnrlon_id
+      else
+        itmp1 = nc_dstgrdcntrlat_id
+        itmp2 = nc_dstgrdcntrlon_id
+        itmp3 = nc_dstgrdcrnrlat_id
+        itmp4 = nc_dstgrdcrnrlon_id
+      endif
+
+      ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp3, grid1_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid1_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        itmp1 = nc_dstgrdcntrlat_id
+        itmp2 = nc_dstgrdcntrlon_id
+        itmp3 = nc_dstgrdcrnrlat_id
+        itmp4 = nc_dstgrdcrnrlon_id
+      else
+        itmp1 = nc_srcgrdcntrlat_id
+        itmp2 = nc_srcgrdcntrlon_id
+        itmp3 = nc_srcgrdcrnrlat_id
+        itmp4 = nc_srcgrdcrnrlon_id
+      endif
+
+      ncstat = nf_put_var_double(nc_file_id, itmp1, grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid2_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrdarea_id
+        itmp2 = nc_srcgrdfrac_id
+        itmp3 = nc_dstgrdarea_id
+        itmp4 = nc_dstgrdfrac_id
+      else
+        itmp1 = nc_dstgrdarea_id
+        itmp2 = nc_dstgrdfrac_id
+        itmp3 = nc_srcgrdarea_id
+        itmp4 = nc_srcgrdfrac_id
+      endif
+
+      if (luse_grid1_area) then
+        ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_area_in)
+      else
+        ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_area)
+      endif
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid1_frac)
+      call netcdf_error_handler(ncstat)
+
+      if (luse_grid2_area) then
+        ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_area_in)
+      else
+        ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_area)
+      endif
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid2_frac)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        ncstat = nf_put_var_int(nc_file_id, nc_srcadd_id, 
+     &                          grid1_add_map1)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_int(nc_file_id, nc_dstadd_id, 
+     &                          grid2_add_map1)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id, 
+     &                             wts_map1)
+        call netcdf_error_handler(ncstat)
+      else
+        ncstat = nf_put_var_int(nc_file_id, nc_srcadd_id, 
+     &                          grid2_add_map2)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_int(nc_file_id, nc_dstadd_id, 
+     &                          grid1_add_map2)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id, 
+     &                             wts_map2)
+        call netcdf_error_handler(ncstat)
+      endif
+
+      ncstat = nf_close(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end subroutine write_remap_scrip
+
+!***********************************************************************
+
+      subroutine write_remap_csm(map_name, interp_file, direction)
+
+!-----------------------------------------------------------------------
+!
+!     writes remap data to a netCDF file using NCAR-CSM conventions
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(in) ::
+     &            map_name     ! name for mapping 
+     &,           interp_file  ! filename for remap data
+
+      integer (kind=int_kind), intent(in) ::
+     &  direction              ! direction of map (1=grid1 to grid2
+                               !                   2=grid2 to grid1)
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len) ::
+     &  grid1_ctmp        ! character temp for grid1 names
+     &, grid2_ctmp        ! character temp for grid2 names
+
+      integer (kind=int_kind) ::
+     &  itmp1             ! integer temp
+     &, itmp2             ! integer temp
+     &, itmp3             ! integer temp
+     &, itmp4             ! integer temp
+     &, nc_numwgts1_id    ! extra netCDF id for additional weights
+     &, nc_src_isize_id   ! extra netCDF id for ni_a
+     &, nc_src_jsize_id   ! extra netCDF id for nj_a
+     &, nc_dst_isize_id   ! extra netCDF id for ni_b
+     &, nc_dst_jsize_id   ! extra netCDF id for nj_b
+     &, nc_rmpmatrix2_id  ! extra netCDF id for high-order remap matrix
+
+      real (kind=dbl_kind), dimension(:),allocatable ::
+     &  wts1              ! CSM wants single array for 1st-order wts
+
+      real (kind=dbl_kind), dimension(:,:),allocatable ::
+     &  wts2              ! write remaining weights in different array
+
+!-----------------------------------------------------------------------
+!
+!     create netCDF file for mapping and define some global attributes
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_create (interp_file, NF_CLOBBER, nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** map name
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'title',
+     &                          len_trim(map_name), map_name)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** normalization option
+      !***
+      ncstat = nf_put_att_text(nc_file_id, NF_GLOBAL, 'normalization',
+     &                         len_trim(normalize_opt), normalize_opt)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** map method
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'map_method',
+     &                          len_trim(map_method), map_method)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** history
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'history',
+     &                          len_trim(history), history)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** file convention
+      !***
+      convention = 'NCAR-CSM'
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'conventions',
+     &                          len_trim(convention), convention)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** source and destination grid names
+      !***
+
+      if (direction == 1) then
+        grid1_ctmp = 'domain_a'
+        grid2_ctmp = 'domain_b'
+      else
+        grid1_ctmp = 'domain_b'
+        grid2_ctmp = 'domain_a'
+      endif
+
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, trim(grid1_ctmp),
+     &                          len_trim(grid1_name), grid1_name)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, trim(grid2_ctmp),
+     &                          len_trim(grid2_name), grid2_name)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     prepare netCDF dimension info
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** define grid size dimensions
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_size
+        itmp2 = grid2_size
+      else
+        itmp1 = grid2_size
+        itmp2 = grid1_size
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'n_a', itmp1, nc_srcgrdsize_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'n_b', itmp2, nc_dstgrdsize_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner dimension
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_corners
+        itmp2 = grid2_corners
+      else
+        itmp1 = grid2_corners
+        itmp2 = grid1_corners
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'nv_a', itmp1, nc_srcgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'nv_b', itmp2, nc_dstgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid rank dimension
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_rank
+        itmp2 = grid2_rank
+      else
+        itmp1 = grid2_rank
+        itmp2 = grid1_rank
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'src_grid_rank', 
+     &                     itmp1, nc_srcgrdrank_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'dst_grid_rank', 
+     &                     itmp2, nc_dstgrdrank_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define first two dims as if 2-d cartesian domain
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_dims(1)
+        if (grid1_rank > 1) then
+          itmp2 = grid1_dims(2)
+        else
+          itmp2 = 0
+        endif
+        itmp3 = grid2_dims(1)
+        if (grid2_rank > 1) then
+          itmp4 = grid2_dims(2)
+        else
+          itmp4 = 0
+        endif
+      else
+        itmp1 = grid2_dims(1)
+        if (grid2_rank > 1) then
+          itmp2 = grid2_dims(2)
+        else
+          itmp2 = 0
+        endif
+        itmp3 = grid1_dims(1)
+        if (grid1_rank > 1) then
+          itmp4 = grid1_dims(2)
+        else
+          itmp4 = 0
+        endif
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'ni_a', itmp1, nc_src_isize_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'nj_a', itmp2, nc_src_jsize_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'ni_b', itmp3, nc_dst_isize_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'nj_b', itmp4, nc_dst_jsize_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define map size dimensions
+      !***
+
+      if (direction == 1) then
+        itmp1 = num_links_map1
+      else
+        itmp1 = num_links_map2
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'n_s', itmp1, nc_numlinks_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'num_wgts', 
+     &                     num_wts, nc_numwgts_id)
+      call netcdf_error_handler(ncstat)
+
+      if (num_wts > 1) then
+        ncstat = nf_def_dim (nc_file_id, 'num_wgts1', 
+     &                       num_wts-1, nc_numwgts1_id)
+        call netcdf_error_handler(ncstat)
+      endif
+
+      !***
+      !*** define grid dimensions
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_dims', NF_INT,
+     &                     1, nc_srcgrdrank_id, nc_srcgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_dims', NF_INT,
+     &                     1, nc_dstgrdrank_id, nc_dstgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     define all arrays for netCDF descriptors
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** define grid center latitude array
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'yc_a',
+     &                     NF_DOUBLE, 1, nc_srcgrdsize_id, 
+     &                     nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'yc_b', 
+     &                     NF_DOUBLE, 1, nc_dstgrdsize_id, 
+     &                     nc_dstgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center longitude array
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'xc_a', 
+     &                     NF_DOUBLE, 1, nc_srcgrdsize_id, 
+     &                     nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'xc_b', 
+     &                     NF_DOUBLE, 1, nc_dstgrdsize_id, 
+     &                     nc_dstgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner lat/lon arrays
+      !***
+
+      nc_dims2_id(1) = nc_srcgrdcorn_id
+      nc_dims2_id(2) = nc_srcgrdsize_id
+
+      ncstat = nf_def_var (nc_file_id, 'yv_a', 
+     &                     NF_DOUBLE, 2, nc_dims2_id, 
+     &                     nc_srcgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'xv_a', 
+     &                     NF_DOUBLE, 2, nc_dims2_id, 
+     &                     nc_srcgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      nc_dims2_id(1) = nc_dstgrdcorn_id
+      nc_dims2_id(2) = nc_dstgrdsize_id
+
+      ncstat = nf_def_var (nc_file_id, 'yv_b', 
+     &                     NF_DOUBLE, 2, nc_dims2_id, 
+     &                     nc_dstgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'xv_b', 
+     &                     NF_DOUBLE, 2, nc_dims2_id, 
+     &                     nc_dstgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** CSM wants all in degrees
+      !***
+
+      grid1_units = 'degrees'
+      grid2_units = 'degrees'
+
+      if (direction == 1) then
+        grid1_ctmp = grid1_units
+        grid2_ctmp = grid2_units
+      else
+        grid1_ctmp = grid2_units
+        grid2_ctmp = grid1_units
+      endif
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcntrlat_id, 
+     &                          'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcntrlat_id, 
+     &                          'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcntrlon_id, 
+     &                          'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcntrlon_id, 
+     &                          'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcrnrlat_id, 
+     &                          'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcrnrlon_id, 
+     &                          'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcrnrlat_id, 
+     &                          'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcrnrlon_id, 
+     &                          'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid mask
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'mask_a', NF_INT,
+     &                     1, nc_srcgrdsize_id, nc_srcgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdimask_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'mask_b', NF_INT,
+     &                     1, nc_dstgrdsize_id, nc_dstgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdimask_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid area arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'area_a', 
+     &                     NF_DOUBLE, 1, nc_srcgrdsize_id, 
+     &                     nc_srcgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdarea_id, 
+     &                          'units', 14, 'square radians')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'area_b', 
+     &                     NF_DOUBLE, 1, nc_dstgrdsize_id, 
+     &                     nc_dstgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdarea_id, 
+     &                          'units', 14, 'square radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid fraction arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'frac_a', 
+     &                     NF_DOUBLE, 1, nc_srcgrdsize_id, 
+     &                     nc_srcgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdfrac_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'frac_b', 
+     &                     NF_DOUBLE, 1, nc_dstgrdsize_id, 
+     &                     nc_dstgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdfrac_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define mapping arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'col', 
+     &                     NF_INT, 1, nc_numlinks_id, 
+     &                     nc_srcadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'row', 
+     &                     NF_INT, 1, nc_numlinks_id, 
+     &                     nc_dstadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'S', 
+     &                     NF_DOUBLE, 1, nc_numlinks_id, 
+     &                     nc_rmpmatrix_id)
+      call netcdf_error_handler(ncstat)
+
+      if (num_wts > 1) then
+        nc_dims2_id(1) = nc_numwgts1_id
+        nc_dims2_id(2) = nc_numlinks_id
+
+        ncstat = nf_def_var (nc_file_id, 'S2', 
+     &                     NF_DOUBLE, 2, nc_dims2_id, 
+     &                     nc_rmpmatrix2_id)
+        call netcdf_error_handler(ncstat)
+      endif
+
+      !***
+      !*** end definition stage
+      !***
+
+      ncstat = nf_enddef(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     compute integer masks
+!
+!-----------------------------------------------------------------------
+
+      if (direction == 1) then
+        allocate (src_mask_int(grid1_size),
+     &            dst_mask_int(grid2_size))
+
+        where (grid2_mask)
+          dst_mask_int = 1
+        elsewhere
+          dst_mask_int = 0
+        endwhere
+
+        where (grid1_mask)
+          src_mask_int = 1
+        elsewhere
+          src_mask_int = 0
+        endwhere
+      else
+        allocate (src_mask_int(grid2_size),
+     &            dst_mask_int(grid1_size))
+
+        where (grid1_mask)
+          dst_mask_int = 1
+        elsewhere
+          dst_mask_int = 0
+        endwhere
+
+        where (grid2_mask)
+          src_mask_int = 1
+        elsewhere
+          src_mask_int = 0
+        endwhere
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     change units of lat/lon coordinates if input units different
+!     from radians. if this is the second mapping, the conversion has
+!     alread been done.
+!
+!-----------------------------------------------------------------------
+
+      if (grid1_units(1:7) == 'degrees' .and. direction == 1) then
+        grid1_center_lat = grid1_center_lat/deg2rad
+        grid1_center_lon = grid1_center_lon/deg2rad
+        grid1_corner_lat = grid1_corner_lat/deg2rad
+        grid1_corner_lon = grid1_corner_lon/deg2rad
+      endif
+
+      if (grid2_units(1:7) == 'degrees' .and. direction == 1) then
+        grid2_center_lat = grid2_center_lat/deg2rad
+        grid2_center_lon = grid2_center_lon/deg2rad
+        grid2_corner_lat = grid2_corner_lat/deg2rad
+        grid2_corner_lon = grid2_corner_lon/deg2rad
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     write mapping data
+!
+!-----------------------------------------------------------------------
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrddims_id
+        itmp2 = nc_dstgrddims_id
+      else
+        itmp2 = nc_srcgrddims_id
+        itmp1 = nc_dstgrddims_id
+      endif
+
+      ncstat = nf_put_var_int(nc_file_id, itmp1, grid1_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, itmp2, grid2_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, nc_srcgrdimask_id, 
+     &                        src_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, nc_dstgrdimask_id,
+     &                        dst_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      deallocate(src_mask_int, dst_mask_int)
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrdcntrlat_id
+        itmp2 = nc_srcgrdcntrlon_id
+        itmp3 = nc_srcgrdcrnrlat_id
+        itmp4 = nc_srcgrdcrnrlon_id
+      else
+        itmp1 = nc_dstgrdcntrlat_id
+        itmp2 = nc_dstgrdcntrlon_id
+        itmp3 = nc_dstgrdcrnrlat_id
+        itmp4 = nc_dstgrdcrnrlon_id
+      endif
+
+      ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp3, grid1_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid1_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        itmp1 = nc_dstgrdcntrlat_id
+        itmp2 = nc_dstgrdcntrlon_id
+        itmp3 = nc_dstgrdcrnrlat_id
+        itmp4 = nc_dstgrdcrnrlon_id
+      else
+        itmp1 = nc_srcgrdcntrlat_id
+        itmp2 = nc_srcgrdcntrlon_id
+        itmp3 = nc_srcgrdcrnrlat_id
+        itmp4 = nc_srcgrdcrnrlon_id
+      endif
+
+      ncstat = nf_put_var_double(nc_file_id, itmp1, grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid2_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrdarea_id
+        itmp2 = nc_srcgrdfrac_id
+        itmp3 = nc_dstgrdarea_id
+        itmp4 = nc_dstgrdfrac_id
+      else
+        itmp1 = nc_dstgrdarea_id
+        itmp2 = nc_dstgrdfrac_id
+        itmp3 = nc_srcgrdarea_id
+        itmp4 = nc_srcgrdfrac_id
+      endif
+
+      if (luse_grid1_area) then
+        ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_area_in)
+      else
+        ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_area)
+      endif
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid1_frac)
+      call netcdf_error_handler(ncstat)
+
+      if (luse_grid2_area) then
+        ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_area)
+      else
+        ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_area)
+      endif
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid2_frac)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        ncstat = nf_put_var_int(nc_file_id, nc_srcadd_id, 
+     &                          grid1_add_map1)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_int(nc_file_id, nc_dstadd_id, 
+     &                          grid2_add_map1)
+        call netcdf_error_handler(ncstat)
+
+        if (num_wts == 1) then
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id, 
+     &                               wts_map1)
+          call netcdf_error_handler(ncstat)
+        else
+          allocate(wts1(num_links_map1),wts2(num_wts-1,num_links_map1))
+
+          wts1 = wts_map1(1,:)
+          wts2 = wts_map1(2:,:)
+
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id, 
+     &                               wts1)
+          call netcdf_error_handler(ncstat)
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix2_id, 
+     &                               wts2)
+          call netcdf_error_handler(ncstat)
+          deallocate(wts1,wts2)
+        endif
+      else
+        ncstat = nf_put_var_int(nc_file_id, nc_srcadd_id, 
+     &                          grid2_add_map2)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_int(nc_file_id, nc_dstadd_id, 
+     &                          grid1_add_map2)
+        call netcdf_error_handler(ncstat)
+
+        if (num_wts == 1) then
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id, 
+     &                               wts_map2)
+          call netcdf_error_handler(ncstat)
+        else
+          allocate(wts1(num_links_map2),wts2(num_wts-1,num_links_map2))
+
+          wts1 = wts_map2(1,:)
+          wts2 = wts_map2(2:,:)
+
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id, 
+     &                               wts1)
+          call netcdf_error_handler(ncstat)
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix2_id, 
+     &                               wts2)
+          call netcdf_error_handler(ncstat)
+          deallocate(wts1,wts2)
+        endif
+      endif
+
+      ncstat = nf_close(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end subroutine write_remap_csm
+
+!***********************************************************************
+
+      subroutine sort_add(add1, add2, weights)
+
+!-----------------------------------------------------------------------
+!
+!     this routine sorts address and weight arrays based on the
+!     destination address with the source address as a secondary
+!     sorting criterion.  the method is a standard heap sort.
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common scalar constants
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     Input and Output arrays
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(inout), dimension(:) ::
+     &        add1,       ! destination address array (num_links)
+     &        add2        ! source      address array
+
+      real (kind=dbl_kind), intent(inout), dimension(:,:) ::
+     &        weights     ! remapping weights (num_wts, num_links)
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) ::
+     &          num_links,          ! num of links for this mapping
+     &          num_wts,            ! num of weights for this mapping
+     &          add1_tmp, add2_tmp, ! temp for addresses during swap
+     &          nwgt,
+     &          lvl, final_lvl,     ! level indexes for heap sort levels
+     &          chk_lvl1, chk_lvl2, max_lvl
+
+      real (kind=dbl_kind), dimension(SIZE(weights,DIM=1)) ::
+     &          wgttmp              ! temp for holding wts during swap
+
+!-----------------------------------------------------------------------
+!
+!     determine total number of links to sort and number of weights
+!
+!-----------------------------------------------------------------------
+
+      num_links = SIZE(add1)
+      num_wts   = SIZE(weights, DIM=1)
+
+!-----------------------------------------------------------------------
+!
+!     start at the lowest level (N/2) of the tree and sift lower 
+!     values to the bottom of the tree, promoting the larger numbers
+!
+!-----------------------------------------------------------------------
+
+      do lvl=num_links/2,1,-1
+
+        final_lvl = lvl
+        add1_tmp = add1(lvl)
+        add2_tmp = add2(lvl)
+        wgttmp(:) = weights(:,lvl)
+
+        !***
+        !*** loop until proper level is found for this link, or reach
+        !*** bottom
+        !***
+
+        sift_loop1: do
+
+          !***
+          !*** find the largest of the two daughters
+          !***
+
+          chk_lvl1 = 2*final_lvl
+          chk_lvl2 = 2*final_lvl+1
+          if (chk_lvl1 .EQ. num_links) chk_lvl2 = chk_lvl1
+
+          if ((add1(chk_lvl1) >  add1(chk_lvl2)) .OR.
+     &       ((add1(chk_lvl1) == add1(chk_lvl2)) .AND.
+     &        (add2(chk_lvl1) >  add2(chk_lvl2)))) then
+            max_lvl = chk_lvl1
+          else 
+            max_lvl = chk_lvl2
+          endif
+
+          !***
+          !*** if the parent is greater than both daughters,
+          !*** the correct level has been found
+          !***
+
+          if ((add1_tmp .GT. add1(max_lvl)) .OR.
+     &       ((add1_tmp .EQ. add1(max_lvl)) .AND.
+     &        (add2_tmp .GT. add2(max_lvl)))) then
+            add1(final_lvl) = add1_tmp
+            add2(final_lvl) = add2_tmp
+            weights(:,final_lvl) = wgttmp(:)
+            exit sift_loop1
+
+          !***
+          !*** otherwise, promote the largest daughter and push
+          !*** down one level in the tree.  if haven't reached
+          !*** the end of the tree, repeat the process.  otherwise
+          !*** store last values and exit the loop
+          !***
+
+          else 
+            add1(final_lvl) = add1(max_lvl)
+            add2(final_lvl) = add2(max_lvl)
+            weights(:,final_lvl) = weights(:,max_lvl)
+
+            final_lvl = max_lvl
+            if (2*final_lvl > num_links) then
+              add1(final_lvl) = add1_tmp
+              add2(final_lvl) = add2_tmp
+              weights(:,final_lvl) = wgttmp(:)
+              exit sift_loop1
+            endif
+          endif
+        end do sift_loop1
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     now that the heap has been sorted, strip off the top (largest)
+!     value and promote the values below
+!
+!-----------------------------------------------------------------------
+
+      do lvl=num_links,3,-1
+
+        !***
+        !*** move the top value and insert it into the correct place
+        !***
+
+        add1_tmp = add1(lvl)
+        add1(lvl) = add1(1)
+
+        add2_tmp = add2(lvl)
+        add2(lvl) = add2(1)
+
+        wgttmp(:) = weights(:,lvl)
+        weights(:,lvl) = weights(:,1)
+
+        !***
+        !*** as above this loop sifts the tmp values down until proper 
+        !*** level is reached
+        !***
+
+        final_lvl = 1
+
+        sift_loop2: do
+
+          !***
+          !*** find the largest of the two daughters
+          !***
+
+          chk_lvl1 = 2*final_lvl
+          chk_lvl2 = 2*final_lvl+1
+          if (chk_lvl2 >= lvl) chk_lvl2 = chk_lvl1
+
+          if ((add1(chk_lvl1) >  add1(chk_lvl2)) .OR.
+     &       ((add1(chk_lvl1) == add1(chk_lvl2)) .AND.
+     &        (add2(chk_lvl1) >  add2(chk_lvl2)))) then
+            max_lvl = chk_lvl1
+          else 
+            max_lvl = chk_lvl2
+          endif
+
+          !***
+          !*** if the parent is greater than both daughters,
+          !*** the correct level has been found
+          !***
+
+          if ((add1_tmp >  add1(max_lvl)) .OR.
+     &       ((add1_tmp == add1(max_lvl)) .AND.
+     &        (add2_tmp >  add2(max_lvl)))) then
+            add1(final_lvl) = add1_tmp
+            add2(final_lvl) = add2_tmp
+            weights(:,final_lvl) = wgttmp(:)
+            exit sift_loop2
+
+          !***
+          !*** otherwise, promote the largest daughter and push
+          !*** down one level in the tree.  if haven't reached
+          !*** the end of the tree, repeat the process.  otherwise
+          !*** store last values and exit the loop
+          !***
+
+          else 
+            add1(final_lvl) = add1(max_lvl)
+            add2(final_lvl) = add2(max_lvl)
+            weights(:,final_lvl) = weights(:,max_lvl)
+
+            final_lvl = max_lvl
+            if (2*final_lvl >= lvl) then
+              add1(final_lvl) = add1_tmp
+              add2(final_lvl) = add2_tmp
+              weights(:,final_lvl) = wgttmp(:)
+              exit sift_loop2
+            endif
+          endif
+        end do sift_loop2
+      end do
+
+      !***
+      !*** swap the last two entries
+      !***
+
+
+      add1_tmp = add1(2)
+      add1(2)  = add1(1)
+      add1(1)  = add1_tmp
+
+      add2_tmp = add2(2)
+      add2(2)  = add2(1)
+      add2(1)  = add2_tmp
+
+      wgttmp (:)   = weights(:,2)
+      weights(:,2) = weights(:,1)
+      weights(:,1) = wgttmp (:)
+
+!-----------------------------------------------------------------------
+
+      end subroutine sort_add
+
+!***********************************************************************
+
+      end module remap_write
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip.f
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip.f	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip.f	(revision 2352)
@@ -0,0 +1,214 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This routine is the driver for computing the addresses and weights 
+!     for interpolating between two grids on a sphere.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: scrip.f,v 1.6 2001/08/21 21:06:44 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      program scrip
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod                  ! module defining data types
+      use constants                  ! module for common constants
+      use iounits                    ! I/O unit manager
+      use timers                     ! CPU timers
+      use grids                      ! module with grid information
+      use remap_vars                 ! common remapping variables
+      use remap_conservative         ! routines for conservative remap
+      use remap_distance_weight      ! routines for dist-weight remap
+      use remap_bilinear             ! routines for bilinear interp
+      use remap_bicubic              ! routines for bicubic  interp
+      use remap_write                ! routines for remap output
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     input namelist variables
+!
+!-----------------------------------------------------------------------
+
+      character (char_len) :: 
+     &           grid1_file,   ! filename of grid file containing grid1
+     &           grid2_file,   ! filename of grid file containing grid2
+     &           interp_file1, ! filename for output remap data (map1)
+     &           interp_file2, ! filename for output remap data (map2)
+     &           map1_name,    ! name for mapping from grid1 to grid2
+     &           map2_name,    ! name for mapping from grid2 to grid1
+     &           map_method,   ! choice for mapping method
+     &           normalize_opt,! option for normalizing weights
+     &           output_opt    ! option for output conventions
+
+      integer (kind=int_kind) ::
+     &           nmap          ! number of mappings to compute (1 or 2)
+
+      namelist /remap_inputs/ grid1_file, grid2_file, 
+     &                        interp_file1, interp_file2,
+     &                        map1_name, map2_name, num_maps,
+     &                        luse_grid1_area, luse_grid2_area,
+     &                        map_method, normalize_opt, output_opt,
+     &                        restrict_type, num_srch_bins
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n,     ! dummy counter
+     &                           iunit  ! unit number for namelist file
+
+!-----------------------------------------------------------------------
+!
+!     initialize timers
+!
+!-----------------------------------------------------------------------
+
+      call timers_init
+      do n=1,max_timers
+        call timer_clear(n)
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     read input namelist
+!
+!-----------------------------------------------------------------------
+
+      grid1_file    = 'unknown'
+      grid2_file    = 'unknown'
+      interp_file1  = 'unknown'
+      interp_file2  = 'unknown'
+      map1_name     = 'unknown'
+      map2_name     = 'unknown'
+      luse_grid1_area = .false.
+      luse_grid2_area = .false.
+      num_maps      = 2
+      map_type      = 1
+      normalize_opt = 'fracarea'
+      output_opt    = 'scrip'
+      restrict_type = 'latitude'
+      num_srch_bins = 900
+
+      call get_unit(iunit)
+      open(iunit, file='scrip_in', status='old', form='formatted')
+      read(iunit, nml=remap_inputs)
+      call release_unit(iunit)
+
+      select case(map_method)
+      case ('conservative')
+        map_type = map_type_conserv
+        luse_grid_centers = .false.
+      case ('bilinear')
+        map_type = map_type_bilinear
+        luse_grid_centers = .true.
+      case ('bicubic')
+        map_type = map_type_bicubic
+        luse_grid_centers = .true.
+      case ('distwgt')
+        map_type = map_type_distwgt
+        luse_grid_centers = .true.
+      case default
+        stop 'unknown mapping method'
+      end select
+
+      select case(normalize_opt(1:4))
+      case ('none')
+        norm_opt = norm_opt_none
+      case ('frac')
+        norm_opt = norm_opt_frcarea
+      case ('dest')
+        norm_opt = norm_opt_dstarea
+      case default
+        stop 'unknown normalization option'
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     initialize grid information for both grids
+!
+!-----------------------------------------------------------------------
+
+      call grid_init(grid1_file, grid2_file)
+
+      write(stdout, *) ' Computing remappings between: ',grid1_name
+      write(stdout, *) '                          and  ',grid2_name
+
+!-----------------------------------------------------------------------
+!
+!     initialize some remapping variables.
+!
+!-----------------------------------------------------------------------
+
+      call init_remap_vars
+
+!-----------------------------------------------------------------------
+!
+!     call appropriate interpolation setup routine based on type of
+!     remapping requested.
+!
+!-----------------------------------------------------------------------
+
+      select case(map_type)
+      case(map_type_conserv)
+        call remap_conserv
+      case(map_type_bilinear)
+        call remap_bilin
+      case(map_type_distwgt)
+        call remap_distwgt
+      case(map_type_bicubic)
+        call remap_bicub
+      case default
+        stop 'Invalid Map Type'
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     reduce size of remapping arrays and then write remapping info
+!     to a file.
+!
+!-----------------------------------------------------------------------
+
+      if (num_links_map1 /= max_links_map1) then
+        call resize_remap_vars(1, num_links_map1-max_links_map1)
+      endif
+      if ((num_maps > 1) .and. (num_links_map2 /= max_links_map2)) then
+        call resize_remap_vars(2, num_links_map2-max_links_map2)
+      endif
+
+      call write_remap(map1_name, map2_name, 
+     &                 interp_file1, interp_file2, output_opt)
+
+!-----------------------------------------------------------------------
+
+      end program scrip
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip_test.f
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip_test.f	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip_test.f	(revision 2352)
@@ -0,0 +1,981 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this program is a short driver that tests the remappings using
+!     a simple analytic field.  the results are written in netCDF
+!     format.
+!
+!     CVS: $Id: scrip_test.f,v 1.6 2000/04/19 21:45:09 pwjones Exp $
+!
+!-----------------------------------------------------------------------
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      program remap_test
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod    ! defines common data types
+      use constants    ! defines common constants
+      use iounits      ! I/O unit manager
+      use netcdf_mod   ! netcdf I/O stuff
+      use grids        ! module containing grid info
+      use remap_vars   ! module containing remapping info
+      use remap_mod    ! module containing remapping routines
+      use remap_read   ! routines for reading remap files
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     input namelist variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) ::
+     &  field_choice   ! choice of field to be interpolated
+
+      character (char_len) :: 
+     &  interp_file,   ! filename containing remap data (map1)
+     &  output_file    ! filename for test results
+
+      namelist /remap_inputs/ field_choice, interp_file, output_file
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character (char_len) :: 
+     &        map_name      ! name for mapping from grid1 to grid2
+
+      integer (kind=int_kind) ::    ! netCDF ids for files and arrays
+     &        ncstat, nc_outfile_id, 
+     &        nc_srcgrdcntrlat_id, nc_srcgrdcntrlon_id,
+     &        nc_dstgrdcntrlat_id, nc_dstgrdcntrlon_id,
+     &        nc_srcgrdrank_id, nc_dstgrdrank_id,
+     &        nc_srcgrdimask_id, nc_dstgrdimask_id,
+     &        nc_srcgrdarea_id, nc_dstgrdarea_id,
+     &        nc_srcgrdfrac_id, nc_dstgrdfrac_id,
+     &        nc_srcarray_id, nc_srcgradlat_id, nc_srcgradlon_id,
+     &        nc_dstarray1_id, nc_dstarray1a_id, nc_dstarray2_id,
+     &        nc_dsterror1_id, nc_dsterror1a_id, nc_dsterror2_id
+
+      integer (kind=int_kind), dimension(:), allocatable ::
+     &        nc_grid1size_id, nc_grid2size_id
+
+!-----------------------------------------------------------------------
+
+      character (char_len) :: 
+     &          dim_name    ! netCDF dimension name
+
+      integer (kind=int_kind) :: i,j,n,imin,imax,idiff,
+     &    ip1,im1,jp1,jm1,nx,ny, ! for computing bicub gradients
+     &    in,is,ie,iw,ine,inw,ise,isw,
+     &    iunit                  ! unit number for namelist file
+
+      integer (kind=int_kind), dimension(:), allocatable ::
+     &    grid1_imask, grid2_imask, grid2_count
+
+      real (kind=dbl_kind) ::
+     &    delew, delns,     ! variables for computing bicub gradients
+     &    length            ! length scale for cosine hill test field
+
+      real (kind=dbl_kind), dimension(:), allocatable ::
+     &    grid1_array, 
+     &    grid1_tmp, 
+     &    grad1_lat, 
+     &    grad1_lon, 
+     &    grad1_latlon, 
+     &    grad1_lat_zero, 
+     &    grad1_lon_zero, 
+     &    grid2_array, 
+     &    grid2_err,
+     &    grid2_tmp
+
+!-----------------------------------------------------------------------
+!
+!     read namelist for file and mapping info
+!
+!-----------------------------------------------------------------------
+
+      call get_unit(iunit)
+      open(iunit, file='scrip_test_in', status='old', form='formatted')
+      read(iunit, nml=remap_inputs)
+      call release_unit(iunit)
+      write(*,nml=remap_inputs)
+
+!-----------------------------------------------------------------------
+!
+!     read remapping data
+!
+!-----------------------------------------------------------------------
+
+      call read_remap(map_name, interp_file)
+
+!-----------------------------------------------------------------------
+!
+!     allocate arrays
+!
+!-----------------------------------------------------------------------
+
+      allocate (grid1_array    (grid1_size), 
+     &          grid1_tmp      (grid1_size),
+     &          grad1_lat      (grid1_size), 
+     &          grad1_lon      (grid1_size), 
+     &          grad1_lat_zero (grid1_size), 
+     &          grad1_lon_zero (grid1_size), 
+     &          grid1_imask    (grid1_size),
+     &          grid2_array    (grid2_size), 
+     &          grid2_err      (grid2_size),
+     &          grid2_tmp      (grid2_size),
+     &          grid2_imask    (grid2_size),
+     &          grid2_count    (grid2_size))
+
+      where (grid1_mask)
+        grid1_imask = 1
+      elsewhere
+        grid1_imask = 0
+      endwhere
+      where (grid2_mask)
+        grid2_imask = 1
+      elsewhere
+        grid2_imask = 0
+      endwhere
+
+!-----------------------------------------------------------------------
+!
+!     setup a NetCDF file for output
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** create netCDF dataset 
+      !***
+
+      ncstat = nf_create (output_file, NF_CLOBBER, nc_outfile_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, NF_GLOBAL, 'title',
+     &                          len_trim(map_name), map_name)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid size dimensions
+      !***
+
+      allocate( nc_grid1size_id(grid1_rank),
+     &          nc_grid2size_id(grid2_rank))
+
+      do n=1,grid1_rank
+        write(dim_name,1000) 'grid1_dim',n
+        ncstat = nf_def_dim (nc_outfile_id, dim_name, 
+     &                       grid1_dims(n), nc_grid1size_id(n))
+        call netcdf_error_handler(ncstat)
+      end do
+
+      do n=1,grid2_rank
+        write(dim_name,1000) 'grid2_dim',n
+        ncstat = nf_def_dim (nc_outfile_id, dim_name, 
+     &                       grid2_dims(n), nc_grid2size_id(n))
+        call netcdf_error_handler(ncstat)
+      end do
+ 1000 format(a9,i1)
+
+      !***
+      !*** define grid center latitude array
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grid_center_lat', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_srcgrdcntrlat_id, 
+     &                          'units', 7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_grid_center_lat', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_dstgrdcntrlat_id, 
+     &                          'units', 7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center longitude array
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grid_center_lon', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_srcgrdcntrlon_id, 
+     &                          'units', 7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_grid_center_lon', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_dstgrdcntrlon_id, 
+     &                          'units', 7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid mask
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grid_imask', NF_INT,
+     &               grid1_rank, nc_grid1size_id, nc_srcgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_srcgrdimask_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_grid_imask', NF_INT,
+     &               grid2_rank, nc_grid2size_id, nc_dstgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_dstgrdimask_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid area arrays
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grid_area', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_grid_area', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid fraction arrays
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grid_frac', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_grid_frac', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define source array
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_array', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcarray_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define gradient arrays
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grad_lat', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgradlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grad_lon', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgradlon_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define destination arrays
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_array1', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstarray1_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_array1a', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstarray1a_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_array2', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstarray2_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define error arrays
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_error1', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dsterror1_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_error1a', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dsterror1a_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_error2', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dsterror2_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** end definition stage
+      !***
+
+      ncstat = nf_enddef(nc_outfile_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     write some grid info
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** write grid center latitude array
+      !***
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcgrdcntrlat_id,
+     &                           grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstgrdcntrlat_id,
+     &                           grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** write grid center longitude array
+      !***
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcgrdcntrlon_id,
+     &                           grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstgrdcntrlon_id,
+     &                           grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** write grid mask
+      !***
+
+      ncstat = nf_put_var_int(nc_outfile_id, nc_srcgrdimask_id,
+     &                        grid1_imask)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_outfile_id, nc_dstgrdimask_id,
+     &                        grid2_imask)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid area arrays
+      !***
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcgrdarea_id,
+     &                           grid1_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstgrdarea_id,
+     &                           grid2_area)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid fraction arrays
+      !***
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcgrdfrac_id,
+     &                           grid1_frac)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstgrdfrac_id,
+     &                           grid2_frac)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     set up fields for test cases based on user choice
+!
+!-----------------------------------------------------------------------
+
+      select case (field_choice)
+      case(1)  !*** cosine hill at lon=pi and lat=0
+
+        length = 0.1*pi2
+
+        grid1_array = cos(grid1_center_lat)*cos(grid1_center_lon)
+        grid2_array = cos(grid2_center_lat)*cos(grid2_center_lon)
+
+        grid1_tmp = acos(-grid1_array)/length
+        grid2_tmp = acos(-grid2_array)/length
+
+        where (grid1_tmp <= one)
+          grad1_lat   = (pi/length)*sin(pi*grid1_tmp)*
+     &                  sin(grid1_center_lat)*cos(grid1_center_lon)/
+     &                  sqrt(one-grid1_array**2)
+          grad1_lon   = (pi/length)*sin(pi*grid1_tmp)*
+     &                  sin(grid1_center_lon)/
+     &                  sqrt(one-grid1_array**2)
+          grid1_array = two + cos(pi*grid1_tmp)
+        elsewhere
+          grid1_array = one
+          grad1_lat   = zero
+          grad1_lon   = zero
+        endwhere
+        
+        where (grid2_tmp <= one)
+          grid2_array = two + cos(pi*grid2_tmp)
+        elsewhere
+          grid2_array = one
+        endwhere
+        
+        where (.not. grid1_mask)
+          grid1_array = zero
+          grad1_lat   = zero
+          grad1_lon   = zero
+        end where
+
+        where (grid2_frac < .001) grid2_array = zero
+
+      case(2)  !*** pseudo-spherical harmonic l=2,m=2
+
+        where (grid1_mask)
+          grid1_array = two + cos(grid1_center_lat)**2*
+     &                    cos(two*grid1_center_lon)
+          grad1_lat   = -sin(two*grid1_center_lat)*
+     &                   cos(two*grid1_center_lon)
+          grad1_lon   = -two*cos(grid1_center_lat)*
+     &                   sin(two*grid1_center_lon)
+        elsewhere
+          grid1_array = zero
+          grad1_lat   = zero
+          grad1_lon   = zero
+        end where
+
+        where (grid2_frac > .001) 
+          grid2_array = two + cos(grid2_center_lat)**2*
+     &                        cos(two*grid2_center_lon)
+        elsewhere
+          grid2_array = zero
+        end where
+
+      case(3)  !*** pseudo-spherical harmonic l=32, m=16
+
+        where (grid1_mask)
+          grid1_array = two + sin(two*grid1_center_lat)**16*
+     &                        cos(16.*grid1_center_lon)
+          grad1_lat   = 32.*sin(two*grid1_center_lat)**15*
+     &                      cos(two*grid1_center_lat)*
+     &                      cos(16.*grid1_center_lon)
+          grad1_lon   = -32.*sin(two*grid1_center_lat)**15*
+     &                       sin(grid1_center_lat)*
+     &                   sin(16.*grid1_center_lon)
+        elsewhere
+          grid1_array = zero
+          grad1_lat   = zero
+          grad1_lon   = zero
+        end where
+
+        where (grid2_frac > .001) 
+          grid2_array = two + sin(two*grid2_center_lat)**16*
+     &                        cos(16.*grid2_center_lon)
+        elsewhere
+          grid2_array = zero
+        end where
+
+      case default
+
+        stop 'Bad choice for field to interpolate'
+
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     if bicubic, we need 3 gradients in logical space
+!
+!-----------------------------------------------------------------------
+
+      if (map_type == map_type_bicubic) then
+        allocate (grad1_latlon (grid1_size)) 
+
+        nx = grid1_dims(1)
+        ny = grid1_dims(2)
+
+        do n=1,grid1_size
+
+          grad1_lat(n) = zero
+          grad1_lon(n) = zero
+          grad1_latlon(n) = zero
+
+          if (grid1_mask(n)) then
+
+            delew = half
+            delns = half
+
+            j = (n-1)/nx + 1
+            i = n - (j-1)*nx
+
+            ip1 = i+1
+            im1 = i-1
+            jp1 = j+1
+            jm1 = j-1
+
+            if (ip1 > nx) ip1 = ip1 - nx
+            if (im1 < 1 ) im1 = nx
+            if (jp1 > ny) then
+              jp1 = j
+              delns = one
+            endif
+            if (jm1 < 1 ) then
+              jm1 = j
+              delns = one
+            endif
+
+            in  = (jp1-1)*nx + i
+            is  = (jm1-1)*nx + i
+            ie  = (j  -1)*nx + ip1
+            iw  = (j  -1)*nx + im1
+
+            ine = (jp1-1)*nx + ip1
+            inw = (jp1-1)*nx + im1
+            ise = (jm1-1)*nx + ip1
+            isw = (jm1-1)*nx + im1
+
+            !*** compute i-gradient
+
+            if (.not. grid1_mask(ie)) then
+              ie = n
+              delew = one
+            endif
+            if (.not. grid1_mask(iw)) then
+              iw = n
+              delew = one
+            endif
+ 
+            grad1_lat(n) = delew*(grid1_array(ie) - grid1_array(iw))
+
+            !*** compute j-gradient
+
+            if (.not. grid1_mask(in)) then
+              in = n
+              delns = one
+            endif
+            if (.not. grid1_mask(is)) then
+              is = n
+              delns = one
+            endif
+ 
+            grad1_lon(n) = delns*(grid1_array(in) - grid1_array(is))
+
+            !*** compute ij-gradient
+
+            delew = half
+            if (jp1 == j .or. jm1 == j) then
+              delns = one
+            else 
+              delns = half
+            endif
+
+            if (.not. grid1_mask(ine)) then
+              if (in /= n) then
+                ine = in
+                delew = one
+              else if (ie /= n) then
+                ine = ie
+                inw = iw
+                if (inw == n) delew = one
+                delns = one
+              else
+                ine = n
+                inw = iw
+                delew = one
+                delns = one
+              endif
+            endif
+
+            if (.not. grid1_mask(inw)) then
+              if (in /= n) then
+                inw = in
+                delew = one
+              else if (iw /= n) then
+                inw = iw
+                ine = ie
+                if (ie == n) delew = one
+                delns = one
+              else
+                inw = n
+                ine = ie
+                delew = one
+                delns = one
+              endif
+            endif
+
+            grad1_lat_zero(n) = delew*(grid1_array(ine) -
+     &                                 grid1_array(inw))
+
+            if (.not. grid1_mask(ise)) then
+              if (is /= n) then
+                ise = is
+                delew = one
+              else if (ie /= n) then
+                ise = ie
+                isw = iw
+                if (isw == n) delew = one
+                delns = one
+              else
+                ise = n
+                isw = iw
+                delew = one
+                delns = one
+              endif
+            endif
+
+            if (.not. grid1_mask(isw)) then
+              if (is /= n) then
+                isw = is
+                delew = one
+              else if (iw /= n) then
+                isw = iw
+                ise = ie
+                if (ie == n) delew = one
+                delns = one
+              else
+                isw = n
+                ise = ie
+                delew = one
+                delns = one
+              endif
+            endif
+
+            grad1_lon_zero(n) = delew*(grid1_array(ise) -
+     &                                 grid1_array(isw))
+
+            grad1_latlon(n) = delns*(grad1_lat_zero(n) -
+     &                               grad1_lon_zero(n))
+
+          endif
+        enddo
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     test a first-order map from grid1 to grid2
+!
+!-----------------------------------------------------------------------
+
+      grad1_lat_zero = zero
+      grad1_lon_zero = zero
+
+      if (map_type /= map_type_bicubic) then
+        call remap(grid2_tmp, wts_map1, grid2_add_map1, grid1_add_map1,
+     &             grid1_array)
+      else
+        call remap(grid2_tmp, wts_map1, grid2_add_map1, grid1_add_map1,
+     &             grid1_array, src_grad1=grad1_lat,
+     &                          src_grad2=grad1_lon,
+     &                          src_grad3=grad1_latlon)
+      endif
+
+      if (map_type == map_type_conserv) then
+        select case (norm_opt)
+        case (norm_opt_none)
+          grid2_err = grid2_frac*grid2_area
+          where (grid2_err /= zero)
+            grid2_tmp = grid2_tmp/grid2_err
+          else where
+            grid2_tmp = zero
+          end where
+        case (norm_opt_frcarea)
+        case (norm_opt_dstarea)
+          where (grid2_frac /= zero)
+            grid2_tmp = grid2_tmp/grid2_frac
+          else where
+            grid2_tmp = zero
+          end where
+        end select
+      end if
+
+      where (grid2_frac > .999)
+        grid2_err = (grid2_tmp - grid2_array)/grid2_array
+      elsewhere 
+        grid2_err = zero
+      end where
+
+      print *,'First order mapping from grid1 to grid2:'
+      print *,'----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_tmp  ),maxval(grid2_tmp  )
+      print *,' Err2 min,max: ',minval(grid2_err),maxval(grid2_err)
+      print *,' Err2    mean: ',sum(abs(grid2_err))/
+     &                          count(grid2_frac > .999)
+
+      !***
+      !*** Conservation Test
+      !***
+
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_tmp  *grid2_area*grid2_frac)
+
+!-----------------------------------------------------------------------
+!
+!     write results to NetCDF file
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcarray_id,
+     &                           grid1_array)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstarray1_id,
+     &                           grid2_tmp  )
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dsterror1_id,
+     &                           grid2_err)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     for conservative mappings:
+!     test a second-order map from grid1 to grid2 with only lat grads
+!
+!-----------------------------------------------------------------------
+
+      if (map_type == map_type_conserv) then
+
+        call remap(grid2_tmp, wts_map1, grid2_add_map1, grid1_add_map1,
+     &             grid1_array, src_grad1=grad1_lat,
+     &                          src_grad2=grad1_lon_zero) 
+
+        select case (norm_opt)
+        case (norm_opt_none)
+          grid2_err = grid2_frac*grid2_area
+          where (grid2_err /= zero)
+            grid2_tmp = grid2_tmp/grid2_err
+          else where
+            grid2_tmp = zero
+          end where
+        case (norm_opt_frcarea)
+        case (norm_opt_dstarea)
+          where (grid2_frac /= zero)
+            grid2_tmp = grid2_tmp/grid2_frac
+          else where
+            grid2_tmp = zero
+          end where
+        end select
+
+        where (grid2_frac > .999)
+          grid2_err = (grid2_tmp - grid2_array)/grid2_array
+        elsewhere 
+          grid2_err = zero
+        end where
+
+        print *,'Second order mapping from grid1 to grid2 (lat only):'
+        print *,'----------------------------------------'
+        print *,'Grid1 min,max: ',minval(grid1_array),
+     &                            maxval(grid1_array)
+        print *,'Grid2 min,max: ',minval(grid2_tmp  ),
+     &                            maxval(grid2_tmp  )
+        print *,' Err2 min,max: ',minval(grid2_err),maxval(grid2_err)
+        print *,' Err2    mean: ',sum(abs(grid2_err))/
+     &                            count(grid2_frac > .999)
+
+        !***
+        !*** Conservation Test
+        !***
+
+        print *,'Conservation:'
+        print *,'Grid1 Integral = ',
+     &          sum(grid1_array*grid1_area*grid1_frac)
+        print *,'Grid2 Integral = ',
+     &          sum(grid2_tmp  *grid2_area*grid2_frac)
+
+!-----------------------------------------------------------------------
+!
+!       write results to NetCDF file
+!
+!-----------------------------------------------------------------------
+
+        ncstat = nf_put_var_double(nc_outfile_id, nc_srcgradlat_id,
+     &                             grad1_lat)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_double(nc_outfile_id, nc_dstarray1a_id,
+     &                             grid2_tmp  )
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_double(nc_outfile_id, nc_dsterror1a_id,
+     &                             grid2_err)
+        call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     for conservative mappings:
+!     test a second-order map from grid1 to grid2
+!
+!-----------------------------------------------------------------------
+
+        call remap(grid2_tmp,wts_map1,grid2_add_map1,grid1_add_map1,
+     &             grid1_array, src_grad1=grad1_lat,
+     &                          src_grad2=grad1_lon) 
+
+        select case (norm_opt)
+        case (norm_opt_none)
+          grid2_err = grid2_frac*grid2_area
+          where (grid2_err /= zero)
+            grid2_tmp = grid2_tmp/grid2_err
+          else where
+            grid2_tmp = zero
+          end where
+        case (norm_opt_frcarea)
+        case (norm_opt_dstarea)
+          where (grid2_frac /= zero)
+            grid2_tmp = grid2_tmp/grid2_frac
+          else where
+            grid2_tmp = zero
+          end where
+        end select
+
+        where (grid2_frac > .999)
+          grid2_err = (grid2_tmp - grid2_array)/grid2_array
+        elsewhere 
+          grid2_err = zero
+        end where
+
+        print *,'Second order mapping from grid1 to grid2:'
+        print *,'-----------------------------------------'
+        print *,'Grid1 min,max: ',minval(grid1_array),
+     &                            maxval(grid1_array)
+        print *,'Grid2 min,max: ',minval(grid2_tmp  ),
+     &                            maxval(grid2_tmp  )
+        print *,' Err2 min,max: ',minval(grid2_err),maxval(grid2_err)
+        print *,' Err2    mean: ',sum(abs(grid2_err))/
+     &                            count(grid2_frac > .999)
+
+        !***
+        !*** Conservation Test
+        !***
+
+        print *,'Conservation:'
+        print *,'Grid1 Integral = ',
+     &           sum(grid1_array*grid1_area*grid1_frac)
+        print *,'Grid2 Integral = ',
+     &           sum(grid2_tmp  *grid2_area*grid2_frac)
+
+!-----------------------------------------------------------------------
+!
+!       write results to NetCDF file
+!
+!-----------------------------------------------------------------------
+
+        ncstat = nf_put_var_double(nc_outfile_id, nc_srcgradlon_id,
+     &                             grad1_lon)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_double(nc_outfile_id, nc_dstarray2_id,
+     &                             grid2_tmp  )
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_double(nc_outfile_id, nc_dsterror2_id,
+     &                             grid2_err)
+        call netcdf_error_handler(ncstat)
+
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     close netCDF file
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_close(nc_outfile_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     calculate some statistics
+!
+!-----------------------------------------------------------------------
+
+      grid2_count = zero
+      grid2_tmp   = zero
+      grid2_err   = zero
+
+      print *,'number of sparse matrix entries ',num_links_map1
+      do n=1,num_links_map1
+        grid2_count(grid2_add_map1(n)) = 
+     &  grid2_count(grid2_add_map1(n)) + 1
+        if (wts_map1(1,n) > one .or. wts_map1(1,n) < zero) then
+          grid2_tmp(grid2_add_map1(n)) = 
+     &    grid2_tmp(grid2_add_map1(n)) + 1
+          grid2_err(grid2_add_map1(n)) = max(abs(wts_map1(1,n)),
+     &    grid2_err(grid2_add_map1(n)) )
+        endif
+      end do
+
+      do n=1,grid2_size
+        if (grid2_tmp(n) > zero) print *,n,grid2_err(n)
+      end do
+
+      imin = minval(grid2_count, mask=(grid2_count > 0))
+      imax = maxval(grid2_count)
+      idiff =  (imax - imin)/10 + 1
+      print *,'total number of dest cells ',grid2_size
+      print *,'number of cells participating in remap ',
+     &   count(grid2_count > zero)
+      print *,'min no of entries/row = ',imin
+      print *,'max no of entries/row = ',imax
+
+      imax = imin + idiff
+      do n=1,10
+        print *,'num of rows with entries between ',imin,' - ',imax-1,
+     &     count(grid2_count >= imin .and. grid2_count < imax)
+        imin = imin + idiff
+        imax = imax + idiff
+      end do
+
+!-----------------------------------------------------------------------
+
+      end program remap_test
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip_test_repeat.f
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip_test_repeat.f	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip_test_repeat.f	(revision 2352)
@@ -0,0 +1,709 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this program is a short driver that tests the remappings using
+!     a simple analytic field.  the results are written in netCDF
+!     format.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: scrip_test_repeat.f,v 1.3 2000/04/19 21:56:26 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      program remap_test_repeat
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod    ! defines common data types
+      use constants    ! defines common constants
+      use iounits      ! I/O unit manager
+      use netcdf_mod   ! netcdf I/O stuff
+      use grids        ! module containing grid info
+      use remap_vars   ! module containing remapping info
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     interface for remap routine
+!
+!-----------------------------------------------------------------------
+
+      interface
+        subroutine remap(dst_array, map_wts, dst_add, src_add, 
+     &                   src_array, src_grad1, src_grad2, src_grad3)
+
+        use kinds_mod
+        use constants
+
+        implicit none
+
+        integer (kind=int_kind), dimension(:), intent(in) ::
+     &       dst_add, src_add 
+
+        real (kind=dbl_kind), dimension(:,:), intent(in) :: map_wts
+
+        real (kind=dbl_kind), dimension(:), intent(in) :: src_array
+
+        real (kind=dbl_kind), dimension(:), intent(in), optional ::
+     &     src_grad1, src_grad2, src_grad3
+
+        real (kind=dbl_kind), dimension(:), intent(inout) :: dst_array
+
+        end subroutine remap
+      end interface
+
+!-----------------------------------------------------------------------
+!
+!     input namelist variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) ::
+     &           field_choice, ! choice of field to be interpolated
+     &           num_repeats   ! number of times to repeat remappings
+
+      character (char_len) :: 
+     &           interp_file1, ! filename containing remap data (map1)
+     &           interp_file2, ! filename containing remap data (map2)
+     &           output_file   ! filename containing output test data
+
+      namelist /remap_inputs/ field_choice, num_repeats,
+     &                        interp_file1, interp_file2, output_file
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character (char_len) :: 
+     &           map_name1,    ! name for mapping from grid1 to grid2
+     &           map_name2     ! name for mapping from grid2 to grid1
+
+      integer (kind=int_kind) ::    ! netCDF ids for files and arrays
+     &        n, ncstat, nc_outfile_id, 
+     &        nc_srcgrdcntrlat_id, nc_srcgrdcntrlon_id,
+     &        nc_dstgrdcntrlat_id, nc_dstgrdcntrlon_id,
+     &        nc_srcgrdrank_id, nc_dstgrdrank_id,
+     &        nc_srcgrdimask_id, nc_dstgrdimask_id,
+     &        nc_srcgrdarea_id, nc_dstgrdarea_id,
+     &        nc_srcgrdfrac_id, nc_dstgrdfrac_id,
+     &        nc_srcarray_id, nc_srcgradlat_id, nc_srcgradlon_id,
+     &        nc_dstarray1_id, nc_dstarray2_id,
+     &        nc_dsterror1_id, nc_dsterror2_id
+
+      integer (kind=int_kind), dimension(:), allocatable ::
+     &        nc_grid1size_id, nc_grid2size_id
+
+!-----------------------------------------------------------------------
+
+      character (char_len) :: 
+     &          dim_name    ! netCDF dimension name
+
+      integer (kind=int_kind) :: i,j,n,
+     &    iunit  ! unit number for namelist file
+
+      integer (kind=int_kind), dimension(:), allocatable ::
+     &    grid1_imask, grid2_imask
+
+      real (kind=dbl_kind) ::
+     &    length            ! length scale for cosine hill test field
+
+      real (kind=dbl_kind), dimension(:), allocatable ::
+     &    grid1_array, 
+     &    grid1_tmp, 
+     &    grad1_lat, 
+     &    grad1_lon, 
+     &    grid2_array, 
+     &    grid2_err,
+     &    grid2_tmp,
+     &    grad2_lat, 
+     &    grad2_lon  
+
+!-----------------------------------------------------------------------
+!
+!     read namelist for file and mapping info
+!
+!-----------------------------------------------------------------------
+
+      call get_unit(iunit)
+      open(iunit, file='repeat_test_in', status='old', form='formatted')
+      read(iunit, nml=remap_inputs)
+      call release_unit(iunit)
+      write(*,nml=remap_inputs)
+
+!-----------------------------------------------------------------------
+!
+!     read remapping data
+!
+!-----------------------------------------------------------------------
+
+      num_maps = 2
+
+      call read_remap(map_name1, map_name2, interp_file1, interp_file2)
+
+!-----------------------------------------------------------------------
+!
+!     allocate arrays
+!
+!-----------------------------------------------------------------------
+
+      allocate (grid1_array    (grid1_size), 
+     &          grid1_tmp      (grid1_size),
+     &          grad1_lat      (grid1_size), 
+     &          grad1_lon      (grid1_size), 
+     &          grid1_imask    (grid1_size),
+     &          grid2_array    (grid2_size), 
+     &          grid2_err      (grid2_size),
+     &          grid2_tmp      (grid2_size),
+     &          grad2_lat      (grid2_size), 
+     &          grad2_lon      (grid2_size), 
+     &          grid2_imask    (grid2_size))
+
+      where (grid1_mask)
+        grid1_imask = 1
+      elsewhere
+        grid1_imask = 0
+      endwhere
+      where (grid2_mask)
+        grid2_imask = 1
+      elsewhere
+        grid2_imask = 0
+      endwhere
+
+!-----------------------------------------------------------------------
+!
+!     setup a NetCDF file for output
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** create netCDF dataset 
+      !***
+
+      ncstat = nf_create (output_file, NF_CLOBBER, nc_outfile_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, NF_GLOBAL, 'title',
+     &                          len_trim(map_name1), map_name1)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid size dimensions
+      !***
+
+      allocate( nc_grid1size_id(grid1_rank),
+     &          nc_grid2size_id(grid2_rank))
+
+      do n=1,grid1_rank
+        write(dim_name,1000) 'grid1_dim',n
+        ncstat = nf_def_dim (nc_outfile_id, dim_name, 
+     &                       grid1_dims(n), nc_grid1size_id(n))
+        call netcdf_error_handler(ncstat)
+      end do
+
+      do n=1,grid2_rank
+        write(dim_name,1000) 'grid2_dim',n
+        ncstat = nf_def_dim (nc_outfile_id, dim_name, 
+     &                       grid2_dims(n), nc_grid2size_id(n))
+        call netcdf_error_handler(ncstat)
+      end do
+ 1000 format(a9,i1)
+
+      !***
+      !*** define grid center latitude array
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grid_center_lat', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_srcgrdcntrlat_id, 
+     &                          'units', 7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_grid_center_lat', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_dstgrdcntrlat_id, 
+     &                          'units', 7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center longitude array
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grid_center_lon', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_srcgrdcntrlon_id, 
+     &                          'units', 7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_grid_center_lon', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_dstgrdcntrlon_id, 
+     &                          'units', 7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid mask
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grid_imask', NF_INT,
+     &               grid1_rank, nc_grid1size_id, nc_srcgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_srcgrdimask_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_grid_imask', NF_INT,
+     &               grid2_rank, nc_grid2size_id, nc_dstgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_dstgrdimask_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid area arrays
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grid_area', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_grid_area', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid fraction arrays
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grid_frac', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_grid_frac', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define source array
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_array', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcarray_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define gradient arrays
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grad_lat', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgradlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grad_lon', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgradlon_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define destination arrays
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_array1', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstarray1_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_array2', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstarray2_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define error arrays
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_error1', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dsterror1_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_error2', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dsterror2_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** end definition stage
+      !***
+
+      ncstat = nf_enddef(nc_outfile_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     write some grid info
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** write grid center latitude array
+      !***
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcgrdcntrlat_id,
+     &                           grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstgrdcntrlat_id,
+     &                           grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** write grid center longitude array
+      !***
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcgrdcntrlon_id,
+     &                           grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstgrdcntrlon_id,
+     &                           grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** write grid mask
+      !***
+
+      ncstat = nf_put_var_int(nc_outfile_id, nc_srcgrdimask_id,
+     &                        grid1_imask)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_outfile_id, nc_dstgrdimask_id,
+     &                        grid2_imask)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid area arrays
+      !***
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcgrdarea_id,
+     &                           grid1_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstgrdarea_id,
+     &                           grid2_area)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid fraction arrays
+      !***
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcgrdfrac_id,
+     &                           grid1_frac)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstgrdfrac_id,
+     &                           grid2_frac)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     set up fields for test cases based on user choice
+!
+!-----------------------------------------------------------------------
+
+      select case (field_choice)
+      case(1)  !*** cosine hill at lon=pi and lat=0
+
+        length = 0.1*pi2
+
+        grid1_array = cos(grid1_center_lat)*cos(grid1_center_lon)
+        grid2_array = cos(grid2_center_lat)*cos(grid2_center_lon)
+
+        grid1_tmp = acos(-grid1_array)/length
+        grid2_tmp = acos(-grid2_array)/length
+
+        where (grid1_tmp <= one)
+          grad1_lat   = (pi/length)*sin(pi*grid1_tmp)*
+     &                  sin(grid1_center_lat)*cos(grid1_center_lon)/
+     &                  sqrt(one-grid1_array**2)
+          grad1_lon   = (pi/length)*sin(pi*grid1_tmp)*
+     &                  sin(grid1_center_lon)/
+     &                  sqrt(one-grid1_array**2)
+          grid1_array = two + cos(pi*grid1_tmp)
+        elsewhere
+          grid1_array = one
+          grad1_lat   = zero
+          grad1_lon   = zero
+        endwhere
+        
+        where (grid2_tmp <= one)
+          grad2_lat   = (pi/length)*sin(pi*grid2_tmp)*
+     &                  sin(grid2_center_lat)*cos(grid2_center_lon)/
+     &                  sqrt(one-grid2_array**2)
+          grad2_lon   = (pi/length)*sin(pi*grid2_tmp)*
+     &                  sin(grid2_center_lon)/
+     &                  sqrt(one-grid2_array**2)
+          grid2_array = two + cos(pi*grid2_tmp)
+        elsewhere
+          grid2_array = one
+          grad2_lat   = zero
+          grad2_lon   = zero
+        endwhere
+        
+        where (.not. grid1_mask)
+          grid1_array = zero
+          grad1_lat   = zero
+          grad1_lon   = zero
+        end where
+
+        where (.not. grid2_mask)
+          grid2_array = zero
+          grad2_lat   = zero
+          grad2_lon   = zero
+        end where
+
+      case(2)  !*** pseudo-spherical harmonic l=2,m=2
+
+        where (grid1_mask)
+          grid1_array = two + cos(grid1_center_lat)**2*
+     &                    cos(two*grid1_center_lon)
+          grad1_lat   = -sin(two*grid1_center_lat)*
+     &                   cos(two*grid1_center_lon)
+          grad1_lon   = -two*cos(grid1_center_lat)*
+     &                   sin(two*grid1_center_lon)
+        elsewhere
+          grid1_array = zero
+          grad1_lat   = zero
+          grad1_lon   = zero
+        end where
+
+        where (grid2_mask)
+          grid2_array = two + cos(grid2_center_lat)**2*
+     &                        cos(two*grid2_center_lon)
+          grad2_lat   = -sin(two*grid2_center_lat)*
+     &                   cos(two*grid2_center_lon)
+          grad2_lon   = -two*cos(grid2_center_lat)*
+     &                   sin(two*grid2_center_lon)
+        elsewhere
+          grid2_array = zero
+          grad2_lat   = zero
+          grad2_lon   = zero
+        end where
+
+      case(3)  !*** pseudo-spherical harmonic l=32, m=16
+
+        where (grid1_mask)
+          grid1_array = two + sin(two*grid1_center_lat)**16*
+     &                        cos(16.*grid1_center_lon)
+          grad1_lat   = 32.*sin(two*grid1_center_lat)**15*
+     &                      cos(two*grid1_center_lat)*
+     &                      cos(16.*grid1_center_lon)
+          grad1_lon   = -32.*sin(two*grid1_center_lat)**15*
+     &                       sin(grid1_center_lat)*
+     &                   sin(16.*grid1_center_lon)
+        elsewhere
+          grid1_array = zero
+          grad1_lat   = zero
+          grad1_lon   = zero
+        end where
+
+        where (grid2_mask)
+          grid2_array = two + sin(two*grid2_center_lat)**16*
+     &                        cos(16.*grid2_center_lon)
+          grad2_lat   = 32.*sin(two*grid2_center_lat)**15*
+     &                      cos(two*grid2_center_lat)*
+     &                      cos(16.*grid2_center_lon)
+          grad2_lon   = -32.*sin(two*grid2_center_lat)**15*
+     &                       sin(grid2_center_lat)*
+     &                   sin(16.*grid2_center_lon)
+        elsewhere
+          grid2_array = zero
+          grad2_lat   = zero
+          grad2_lon   = zero
+        end where
+
+      case default
+
+        stop 'Bad choice for field to interpolate'
+
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     test repeated first-order maps between grid1 and grid2
+!
+!-----------------------------------------------------------------------
+
+      call remap(grid2_tmp, wts_map1, grid2_add_map1, grid1_add_map1,
+     &           grid1_array)
+      do n=1,num_repeats
+        call remap(grid1_tmp, wts_map2, grid1_add_map2, grid2_add_map2,
+     &             grid2_tmp)
+        call remap(grid2_tmp, wts_map1, grid2_add_map1, grid1_add_map1,
+     &             grid1_tmp)
+      end do
+
+      where (grid2_frac > .999)
+        grid2_err = (grid2_tmp - grid2_array)/grid2_array
+      elsewhere 
+        grid2_err = zero
+      end where
+
+      print *,'First order mapping from grid1 to grid2:'
+      print *,'----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_tmp  ),maxval(grid2_tmp  )
+      print *,' Err2 min,max: ',minval(grid2_err),maxval(grid2_err)
+      print *,' Err2    mean: ',sum(abs(grid2_err))/
+     &                          count(grid2_frac > .001)
+
+      !***
+      !*** Conservation Test
+      !***
+
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_tmp  *grid2_area*grid2_frac)
+
+!-----------------------------------------------------------------------
+!
+!     write results to NetCDF file
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcarray_id,
+     &                           grid1_array)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstarray1_id,
+     &                           grid2_tmp  )
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dsterror1_id,
+     &                           grid2_err)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     test repeated second-order mapppings between grid1 and grid2
+!
+!-----------------------------------------------------------------------
+
+      if (num_wts > 1) then
+
+      call remap(grid2_tmp  , wts_map1, grid2_add_map1, grid1_add_map1,
+     &           grid1_array, src_grad1=grad1_lat,
+     &                        src_grad2=grad1_lon) 
+
+      do n=1,num_repeats
+        call remap(grid1_tmp, wts_map2, grid1_add_map2, grid2_add_map2,
+     &             grid2_tmp, src_grad1=grad2_lat,
+     &                        src_grad2=grad2_lon) 
+
+        call remap(grid2_tmp, wts_map1, grid2_add_map1, grid1_add_map1,
+     &             grid1_tmp, src_grad1=grad1_lat,
+     &                        src_grad2=grad1_lon) 
+
+      end do
+
+      where (grid2_frac > .999)
+        grid2_err = (grid2_tmp - grid2_array)/grid2_array
+      elsewhere 
+        grid2_err = zero
+      end where
+
+      print *,'Second order mapping from grid1 to grid2:'
+      print *,'-----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_tmp  ),maxval(grid2_tmp  )
+      print *,' Err2 min,max: ',minval(grid2_err),maxval(grid2_err)
+      print *,' Err2    mean: ',sum(abs(grid2_err))/
+     &                          count(grid2_frac > .001)
+
+      !***
+      !*** Conservation Test
+      !***
+
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_tmp  *grid2_area*grid2_frac)
+
+!-----------------------------------------------------------------------
+!
+!     write results to NetCDF file
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcgradlon_id,
+     &                           grad1_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstarray2_id,
+     &                           grid2_tmp  )
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dsterror2_id,
+     &                           grid2_err)
+      call netcdf_error_handler(ncstat)
+
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     close netCDF file
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_close(nc_outfile_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end program remap_test_repeat
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/timers.f
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/timers.f	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/timers.f	(revision 2352)
@@ -0,0 +1,343 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module uses F90 cpu time routines to allowing setting of
+!     multiple CPU timers.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: timers.f,v 1.2 2000/04/19 21:56:26 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module timers
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod
+
+      implicit none
+
+      integer (kind=int_kind), parameter ::  
+     &     max_timers = 99  ! max number of timers allowed
+
+      integer (kind=int_kind), save :: 
+     &     cycles_max       ! max value of clock allowed by system
+
+      integer (kind=int_kind), dimension(max_timers), save :: 
+     &     cycles1,         ! cycle number at start for each timer
+     &     cycles2          ! cycle number at stop  for each timer
+
+      real (kind=real_kind), save ::  
+     &     clock_rate       ! clock_rate in seconds for each cycle
+
+      real (kind=real_kind), dimension(max_timers), save ::  
+     &     cputime          ! accumulated cpu time in each timer
+
+      character (len=8), dimension(max_timers), save ::  
+     &     status           ! timer status string
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine timer_check(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine checks a given timer.  This is primarily used to
+!     periodically accumulate time in the timer to prevent timer cycles
+!     from wrapping around max_cycles.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::  
+     &    timer            ! timer number
+
+!-----------------------------------------------------------------------
+
+      if (status(timer) .eq. 'running') then
+        call timer_stop (timer)
+        call timer_start(timer)
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timer_check
+
+!***********************************************************************
+
+      subroutine timer_clear(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine resets a given timer.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::  
+     &    timer            ! timer number
+
+!-----------------------------------------------------------------------
+
+      cputime(timer) = 0.0_real_kind  ! clear the timer
+
+!-----------------------------------------------------------------------
+
+      end subroutine timer_clear
+
+!***********************************************************************
+
+      function timer_get(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine returns the result of a given timer.  This can be
+!     called instead of timer_print so that the calling routine can 
+!     print it in desired format.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::  
+     &    timer            ! timer number
+
+!-----------------------------------------------------------------------
+!
+!     Output Variables:
+!
+!-----------------------------------------------------------------------
+
+      real (kind=real_kind) ::  
+     &     timer_get   ! accumulated cputime in given timer
+
+!-----------------------------------------------------------------------
+
+      if (status(timer) .eq. 'stopped') then
+        timer_get = cputime(timer)
+      else
+        call timer_stop(timer)
+        timer_get = cputime(timer)
+        call timer_start(timer)
+      endif
+
+!-----------------------------------------------------------------------
+
+      end function timer_get
+
+!***********************************************************************
+
+      subroutine timer_print(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine prints the accumulated cpu time in given timer.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::  
+     &    timer            ! timer number
+
+!-----------------------------------------------------------------------
+
+      !--- 
+      !--- print the cputime accumulated for timer 
+      !--- make sure timer is stopped
+      !---
+
+      if (status(timer) .eq. 'stopped') then
+        write(*,"(' CPU time for timer',i3,':',1p,e16.8)")  
+     &       timer,cputime(timer)
+      else
+        call timer_stop(timer)
+        write(*,"(' CPU time for timer',i3,':',1p,e16.8)")  
+     &       timer,cputime(timer)
+        call timer_start(timer)
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timer_print
+
+!***********************************************************************
+
+      subroutine timer_start(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine starts a given timer.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::  
+     &    timer            ! timer number
+
+!-----------------------------------------------------------------------
+
+      !---
+      !--- Start the timer and change timer status.
+      !---
+
+      if (status(timer) .eq. 'stopped') then
+        call system_clock(count=cycles1(timer))
+        status(timer) = 'running'
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timer_start
+
+!***********************************************************************
+
+      subroutine timer_stop(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine stops a given timer.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::  
+     &    timer            ! timer number
+
+!-----------------------------------------------------------------------
+
+      if (status(timer) .eq. 'running') then
+
+        !---
+        !--- Stop the desired timer.
+        !---
+
+        call system_clock(count=cycles2(timer))
+
+        !---
+        !--- check and correct for cycle wrapping
+        !---
+
+        if (cycles2(timer) .ge. cycles1(timer)) then
+          cputime(timer) = cputime(timer) + clock_rate*  
+     &                     (cycles2(timer) - cycles1(timer))
+        else
+          cputime(timer) = cputime(timer) + clock_rate*  
+     &                (cycles2(timer) - cycles1(timer) + cycles_max)
+        endif
+
+        !---
+        !--- Change timer status.
+        !---
+
+        status(timer)='stopped'
+
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timer_stop
+
+!***********************************************************************
+
+      subroutine timers_init
+
+!-----------------------------------------------------------------------
+!
+!     This routine initializes some machine parameters necessary for
+!     computing cpu time from F90 intrinsics.
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: cycles ! count rate return by sys_clock
+
+!-----------------------------------------------------------------------
+
+      !---
+      !--- Initialize timer arrays and clock_rate.
+      !---
+
+      clock_rate = 0.0_real_kind
+      cycles1    = 0
+      cycles2    = 0
+      cputime    = 0.0_real_kind
+      status     = 'stopped'
+
+      !---
+      !--- Call F90 intrinsic system_clock to determine clock rate
+      !--- and maximum cycles.  If no clock available, print message.
+      !---
+
+      call system_clock(count_rate=cycles, count_max=cycles_max)
+
+      if (cycles /= 0) then
+        clock_rate = 1.0_real_kind/real(cycles)
+      else
+        clock_rate = 0.0_real_kind
+        print *, '--- No system clock available ---'
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timers_init
+
+!***********************************************************************
+
+      end module timers
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/bin/freeform.py
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/bin/freeform.py	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/bin/freeform.py	(revision 2352)
@@ -0,0 +1,115 @@
+#!/usr/bin/env python2.6
+
+import os
+import shutil
+
+def freer(oldname, newname, fdir, edits):
+
+    fin = file(os.path.join(fdir,oldname))
+    lines = fin.readlines()
+    fin.close()
+
+    if not os.path.exists('src'):
+        print "creating src directory"
+        os.mkdir('src')
+    fout = file(os.path.join('src',newname), 'w')
+
+    lastline = None
+    for nextline in lines:
+        for edit in edits:
+            nextline = nextline.replace(edit[0],edit[1])
+        if nextline.strip().startswith('&'):
+            parts = lastline.split('!')
+            if parts[0].endswith('\n'):
+                parts[0] = parts[0].replace('\n',' &\n')
+            else:
+                parts[0] = parts[0] + ' & '
+            lastline = '!'.join(parts)
+            nextline = nextline.replace('&',' ')
+        if lastline is not None:
+            fout.write(lastline)
+        lastline = nextline
+
+    # - write out last line (this assumes it is not a continuation line)
+    fout.write(lastline)
+
+def scrip(adir, apairs, edits=[]):
+
+    if not os.path.exists('src'):
+        print "creating src directory"
+        os.mkdir('src')
+
+    for (f1,f2) in apairs:
+        if not f2.endswith('.f90'):
+            shutil.copy(os.path.join(adir,f1), os.path.join('src',f2))
+        else:
+            freer(f1,f2,adir,edits)
+
+if __name__ == "__main__":
+
+    # - changes to scrip routines made here
+
+    pairs = [('constants.f', 'constants.f90'),
+              ('copyright', 'copyright'),
+              ('grids.f', 'grids.f90'),
+              ('iounits.f', 'iounits.f90'),
+              ('kinds_mod.f', 'kinds_mod.f90'),
+              ('netcdf.f', 'netcdf_mod.f90'),
+              ('remap.f', 'remap.f90'),
+              ('remap_bicubic.f', 'remap_bicubic.f90'),
+              ('remap_bilinear.f', 'remap_bilinear.f90'),
+              ('remap_conserv.f', 'remap_conserv.f90'),
+              ('remap_distwgt.f', 'remap_distwgt.f90'),
+              ('remap_read.f', 'remap_read.f90'),
+              ('remap_vars.f', 'remap_vars.f90'),
+              ('remap_write.f', 'remap_write.f90'),
+              ('timers.f', 'timers.f90')]
+
+    # - add some edits
+    # - note that this is very crude method since every line is inspected for the first string
+    # - in every input file
+    # - you have been warned!
+
+    ed1 = [" .and."]
+    ed2 = ["subroutine netcdf_error_handler(istat, mess)"]
+    ed3 = ["    &    istat   ! integer status returned by netCDF function call",
+           "      character (len=*), intent(in), optional :: mess"]
+    ed4 = ["       if (present(mess)) then",
+           "         print *,'Error in netCDF: ',nf_strerror(istat), 'Message: ',mess",
+           "       else",
+           "         print *,'Error in netCDF: ',nf_strerror(istat)",
+           "       endif"]
+
+    edits = [(". and.",'\n'.join(ed1)),
+             ("subroutine netcdf_error_handler(istat)", '\n'.join(ed2)),
+             ("    &    istat   ! integer status returned by netCDF function call", '\n'.join(ed3)),
+             ("        print *,'Error in netCDF: ',nf_strerror(istat)", '\n'.join(ed4))
+            ]
+    scrip('SCRIP1.4/source', pairs, edits)
+
+
+    # - on to NOCS routines
+
+    pairs = [('scrip.F90', 'scrip.F90'),
+             ('scripgrid.F90', 'scripgrid.F90'),
+             ('scripgrid_mod.F90', 'scripgrid_mod.F90'),
+             ('scripinterp.F90', 'scripinterp.F90'),
+             ('scripinterp_mod.F90', 'scripinterp_mod.F90'),
+             ('scripshape.F90', 'scripshape.F90')]
+    scrip('nocsutil', pairs)
+
+    changes = """
+      SCRIP code, version 1.4, from Los Alamos National Laboratory (http://climate.lanl.gov/Software/SCRIP)
+
+      Changes made at NOCS for inclusion of weights generation code in NEMO 3.3 and later:
+
+          - File extensions changed from '.f' to '.f90'
+          - File netcdf.f renamed as netcdf_mod.f90 to avoid clash with netcdf library module filename
+          - File netcdf.f modified to add error message to netcdf_error_handler
+          - Small bug in remap_conserv when using gfortran compiler: replace ". and." with " .and."
+          - continuation lines reformatted with '&' moved from the start of the continuation line to 
+            the end of the line before
+    """
+    fp = file("src/CHANGES_BY_NOCS","w")
+    fp.write(changes)
+    fp.close()
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/nocsutil/CHANGES
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/nocsutil/CHANGES	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/nocsutil/CHANGES	(revision 2352)
@@ -0,0 +1,20 @@
+Release 1.1
+===========
+Modified for compilation by fcm in NEMO 3.3 framework.
+SCRIP 1.4 package included in unmodified form.
+python script added to transform into correct shape for fcm, producing copied code in 'src' directory
+
+scripshape.F90 now has one possible command line argument: the namelist file
+               from which it reads the names of the input and output files 
+               as well as the value for the cyclicity attribute
+
+Because gfortran doesnt understand ICHAR and GETCHAR system routines default behaviour of all programs
+is to ask for namelist filename during execution rather than reading it from the command line.
+Define symbol ARGC at compilation to return to original command line behaviour.
+
+Release 1.0
+===========
+Routines written by sga and acc at NOCS to use SCRIP library to produce weights
+
+Compilation by makefile and explicit compiler and options.
+
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/nocsutil/namelist_example_bilin
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/nocsutil/namelist_example_bilin	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/nocsutil/namelist_example_bilin	(revision 2352)
@@ -0,0 +1,101 @@
+&comments
+ -----------------------------------------------------------------------------------
+ - grid_inputs holds parameters for the scripgrid routine which reformats information 
+   about the input grids
+ - scripgrid always needs a coordinates.nc file in the
+   current directory and creates the remapped grid file correspondingly
+ - it uses the following namelist block to determine its actions
+     method:  only 'regular' is yet implemented, this assumes a cartesian grid
+     input_lon: name of longitude variable in the input_file
+     input_lat: name of latitude variable in the input_file
+     nemo_lon: name of longitude variable in the coordinates.nc
+     nemo_lat: name of latitude variable in the coordinates.nc
+/
+&grid_inputs
+    input_file = 'snow_1m_DUM_1958.nc'
+    nemo_file = 'coordinates.nc'
+    datagrid_file = 'remap_data_grid.nc'
+    nemogrid_file = 'remap_nemo_grid.nc'
+    method = 'regular'
+    input_lon = 'lon'
+    input_lat = 'lat'
+    nemo_lon = 'glamt'
+    nemo_lat = 'gphit'
+    nemo_mask = 'none'
+    nemo_mask_value = 10
+    input_mask = 'none'
+    input_mask_value = 10
+/
+&comments
+ -----------------------------------------------------------------------------------
+ - remap_inputs holds parameters for the scrip routine which calculates the weights
+   needed to convert between two grids
+ - two remap grid files are required as output by scripgrid
+ - num_maps is either 1 or 2 depending on whether the reverse transformation is required
+ - one or two interp_file names are then supplied; these hold the weights to convert 
+   one grid to another
+ - the map_name variable is just descriptive
+ - map_method can be 'bilinear' 'bicubic' or 'conservative' (the latter untested)
+ - normalize_opt should usually be 'frac' or else the user needs to do this scaling
+   manually (this seems to the case for fractional ice cover)
+ - restrict_type should be 'latitude' or 'latlon' in which case num_srch_bins only are 
+   used in one or two directions
+ - use_grid_area fields override the scrip calculation of area in case the model gets
+   slightly different answers, but the area needs to be supplied in the input files
+ - output_opt may be supplied and set to either 'scrip' or 'ncar-csm'
+/
+&remap_inputs
+    num_maps = 1
+    grid1_file = 'remap_data_grid.nc'
+    grid2_file = 'remap_nemo_grid.nc'
+    interp_file1 = 'data_nemo_bilin.nc'
+    interp_file2 = 'nemo_data_bilin.nc'
+    map1_name = 'data to nemo bilin Mapping'
+    map2_name = 'nemo to data bilin Mapping'
+    map_method = 'bilinear'
+    normalize_opt = 'frac'
+    output_opt = 'scrip'
+    restrict_type = 'latitude'
+    num_srch_bins = 90 
+    luse_grid1_area = .false.
+    luse_grid2_area = .false.
+/
+
+&interp_inputs
+    input_file = "snow_1m_DUM_1958.nc"
+    interp_file = "data_nemo_bilin.nc"
+    input_name = "snow"
+    input_start = 1,1,1,1
+    input_stride = 1,1,1,1
+    input_stop = 0,0,0,1
+    input_vars = 'initial_time0_hours'
+/
+
+&interp_outputs
+    output_file = "snow_orca.nc"
+    output_mode = "create"
+    output_dims = 'x', 'y', 'time_counter'
+    output_scaling = "snow|1.0", "time_counter|86400.0"
+    output_name = 'snow'
+    output_lon = 'x'
+    output_lat = 'y'
+    output_vars = 'time_counter'
+    output_attributes = 'time_counter|units|seconds since 1995-00-00 00:00:00',
+                        'time_counter|calendar|noleap',
+                        'snow|units|mm/s'
+/
+
+&comments
+ -----------------------------------------------------------------------------------
+ -  shape_inputs are the input fields required by scripshape.f90
+ -  first is the interpolation file created by scrip.f90 mapping data to model grid
+ -  second is the name of the output weights file to create
+ -  third is the east-west wrap to assume in the model (needed when calculating gradient 
+          terms in the bicubic scheme); the number is just the number of columns on one side
+          that are repeats of those on the opposite side (-1 for not cyclic)
+/
+&shape_inputs
+    interp_file = 'data_nemo_bilin.nc'
+    output_file = 'weights_bilin.nc'
+    ew_wrap     = 0
+/
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scrip.F90
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scrip.F90	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scrip.F90	(revision 2352)
@@ -0,0 +1,232 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This routine is the driver for computing the addresses and weights 
+!     for interpolating between two grids on a sphere.
+!
+!     Modified slightly to get name of namelist file from command line - sga 2/12/05
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: scrip.f,v 1.6 2001/08/21 21:06:44 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      program scrip
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod                  ! module defining data types
+      use constants                  ! module for common constants
+      use iounits                    ! I/O unit manager
+      use timers                     ! CPU timers
+      use grids                      ! module with grid information
+      use remap_vars                 ! common remapping variables
+      use remap_conservative         ! routines for conservative remap
+      use remap_distance_weight      ! routines for dist-weight remap
+      use remap_bilinear             ! routines for bilinear interp
+      use remap_bicubic              ! routines for bicubic  interp
+      use remap_write                ! routines for remap output
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     input namelist variables
+!
+!-----------------------------------------------------------------------
+
+      character (char_len) :: &
+         grid1_file,       &  ! filename of grid file containing grid1
+         grid2_file,       &  ! filename of grid file containing grid2
+         interp_file1,     &  ! filename for output remap data (map1)
+         interp_file2,     &  ! filename for output remap data (map2)
+         map1_name,        &  ! name for mapping from grid1 to grid2
+         map2_name,        &  ! name for mapping from grid2 to grid1
+         map_method,       &  ! choice for mapping method
+         normalize_opt,    &  ! option for normalizing weights
+         output_opt           ! option for output conventions
+
+      integer (kind=int_kind) :: &
+         nmap                 ! number of mappings to compute (1 or 2)
+
+      namelist /remap_inputs/ grid1_file, grid2_file,  &
+         interp_file1, interp_file2,                   &
+         map1_name, map2_name, num_maps,               &
+         luse_grid1_area, luse_grid2_area,             &
+         map_method, normalize_opt, output_opt,        &
+         restrict_type, num_srch_bins
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n,   &  ! dummy counter
+                                 iunit   ! unit number for namelist file
+
+      character (char_len) :: nm_in
+#if defined ARGC
+      integer :: iargc
+      external iargc
+
+      if (iargc() == 1) then
+        call getarg(1, nm_in)
+      else
+        write(6,*) 'need name of namelist file'
+        stop
+      endif
+#else
+      write(6,*) 'enter name for namelist file'
+      read(5,*) nm_in
+#endif
+
+!-----------------------------------------------------------------------
+!
+!     initialize timers
+!
+!-----------------------------------------------------------------------
+
+      call timers_init
+      do n=1,max_timers
+        call timer_clear(n)
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     read input namelist
+!
+!-----------------------------------------------------------------------
+
+      grid1_file    = 'unknown'
+      grid2_file    = 'unknown'
+      interp_file1  = 'unknown'
+      interp_file2  = 'unknown'
+      map1_name     = 'unknown'
+      map2_name     = 'unknown'
+      luse_grid1_area = .false.
+      luse_grid2_area = .false.
+      num_maps      = 2
+      map_type      = 1
+      normalize_opt = 'fracarea'
+      output_opt    = 'scrip'
+      restrict_type = 'latitude'
+      num_srch_bins = 900
+
+      call get_unit(iunit)
+      open(iunit, file=nm_in, status='old', form='formatted')
+      read(iunit, nml=remap_inputs)
+      call release_unit(iunit)
+
+      select case(map_method)
+      case ('conservative')
+        map_type = map_type_conserv
+        luse_grid_centers = .false.
+      case ('bilinear')
+        map_type = map_type_bilinear
+        luse_grid_centers = .true.
+      case ('bicubic')
+        map_type = map_type_bicubic
+        luse_grid_centers = .true.
+      case ('distwgt')
+        map_type = map_type_distwgt
+        luse_grid_centers = .true.
+      case default
+        stop 'unknown mapping method'
+      end select
+
+      select case(normalize_opt(1:4))
+      case ('none')
+        norm_opt = norm_opt_none
+      case ('frac')
+        norm_opt = norm_opt_frcarea
+      case ('dest')
+        norm_opt = norm_opt_dstarea
+      case default
+        stop 'unknown normalization option'
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     initialize grid information for both grids
+!
+!-----------------------------------------------------------------------
+
+      call grid_init(grid1_file, grid2_file)
+
+      write(stdout, *) ' Computing remappings between: ',grid1_name
+      write(stdout, *) '                          and  ',grid2_name
+
+!-----------------------------------------------------------------------
+!
+!     initialize some remapping variables.
+!
+!-----------------------------------------------------------------------
+
+      call init_remap_vars
+
+!-----------------------------------------------------------------------
+!
+!     call appropriate interpolation setup routine based on type of
+!     remapping requested.
+!
+!-----------------------------------------------------------------------
+
+      select case(map_type)
+      case(map_type_conserv)
+        call remap_conserv
+      case(map_type_bilinear)
+        call remap_bilin
+      case(map_type_distwgt)
+        call remap_distwgt
+      case(map_type_bicubic)
+        call remap_bicub
+      case default
+        stop 'Invalid Map Type'
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     reduce size of remapping arrays and then write remapping info
+!     to a file.
+!
+!-----------------------------------------------------------------------
+
+      if (num_links_map1 /= max_links_map1) then
+        call resize_remap_vars(1, num_links_map1-max_links_map1)
+      endif
+      if ((num_maps > 1) .and. (num_links_map2 /= max_links_map2)) then
+        call resize_remap_vars(2, num_links_map2-max_links_map2)
+      endif
+
+      call write_remap(map1_name, map2_name, &
+                       interp_file1, interp_file2, output_opt)
+
+!-----------------------------------------------------------------------
+
+      end program scrip
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripgrid.F90
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripgrid.F90	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripgrid.F90	(revision 2352)
@@ -0,0 +1,26 @@
+! ==============================================================================
+
+PROGRAM scripgrid
+
+  USE scripgrid_mod
+
+  CHARACTER(char_len) :: infile
+
+#if defined ARGC
+  INTEGER :: IARGC
+  EXTERNAL IARGC
+
+  if (IARGC() == 1) then
+    CALL GETARG(1, infile)
+    CALL convert( infile )
+  ELSE
+    write(6,*) 'need to supply a namelist file'
+  ENDIF
+#else
+  write(6,*) 'enter name of namelist file'
+  read(5,*) infile
+
+  CALL convert( infile )
+#endif
+
+END PROGRAM scripgrid
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripgrid_mod.F90
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripgrid_mod.F90	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripgrid_mod.F90	(revision 2352)
@@ -0,0 +1,764 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module creates grid description files for input to the SCRIP code
+!
+!-----------------------------------------------------------------------
+
+MODULE scripgrid_mod
+
+  USE kinds_mod
+  USE constants
+  USE iounits
+  USE netcdf
+  USE netcdf_mod
+  
+  IMPLICIT NONE
+
+  !-----------------------------------------------------------------------
+  !     module variables that describe the grid
+
+  INTEGER (kind=int_kind), parameter :: &
+       grid_rank = 2,         &
+       grid_corners = 4
+  INTEGER (kind=int_kind) :: nx, ny, grid_size
+  INTEGER (kind=int_kind), dimension(2) :: &
+       grid_dims,    &  ! size of x, y dimensions
+       grid_dim_ids     ! ids of the x, y dimensions
+  INTEGER (kind=int_kind), ALLOCATABLE, DIMENSION(:) :: &
+       grid_imask          ! land-sea mask
+  REAL (kind=int_kind), ALLOCATABLE, DIMENSION(:) :: &
+       grid_center_lat, &  ! lat/lon coordinates for
+       grid_center_lon     ! each grid center in degrees
+  REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:,:) :: &
+       grid_corner_lat, &  ! lat/lon coordinates for
+       grid_corner_lon     ! each grid corner in degrees
+  REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:,:,:) :: &
+       corner_lon, &
+       corner_lat
+  REAL (kind=dbl_kind), PARAMETER :: circle = 360.0
+
+  !-----------------------------------------------------------------------
+  !     module variables that describe the netcdf file
+
+  INTEGER (kind=int_kind) :: &
+       ncstat,           &   ! general netCDF status variable
+       ncid_in
+
+CONTAINS
+
+  ! ==============================================================================
+  
+  SUBROUTINE convert(nm_in)
+  
+    ! -----------------------------------------------------------------------------
+    ! - input variables
+  
+    CHARACTER(char_len), INTENT(in) ::  &
+      nm_in
+  
+    ! -----------------------------------------------------------------------------
+    ! - local variables
+  
+    CHARACTER(char_len) ::  &
+      nemo_file, input_file, method, input_lon, input_lat, datagrid_file, &
+      nemogrid_file, nemo_lon, nemo_lat, corn_lon, corn_lat, nemo_mask, input_mask
+    INTEGER (kind=int_kind), dimension(2) :: &
+      offset
+    INTEGER (kind=int_kind) :: &
+      iunit, nemo_mask_value, input_mask_value
+  
+    namelist /grid_inputs/ nemo_file, input_file, datagrid_file, nemogrid_file,  &
+                           method, input_lon, input_lat, nemo_lon, nemo_lat,     &
+                           nemo_mask, nemo_mask_value, input_mask, input_mask_value
+  
+    !-----------------------------------------------------------------------
+    ! - namelist describing the processing
+    !   note that mask_value is the minimum good value,
+    !   so that where the mask is less than the value is masked
+
+    nemo_file = "coordinates.nc"
+    nemo_lon = "glamt"
+    nemo_lat = "gphit"
+    input_lon = "lon"
+    input_lat = "lat"
+    input_mask = "none"
+    input_mask_value = 0
+    datagrid_file = 'remap_data_grid.nc'
+    nemogrid_file = 'remap_nemo_grid.nc'
+
+    call get_unit(iunit)
+    open(iunit, file=nm_in, status='old', form='formatted')
+    read(iunit, nml=grid_inputs) 
+    call release_unit(iunit)
+
+    if (trim(nemo_file) .eq. 'coordinates.nc') then
+
+      ! set up the names of the corner variables for a given input
+      ! the offset represents what needs to be added to (i,j) to get to the correct 
+      ! element in the corner arrays to correspond to the point northeast of the center
+      if (nemo_lon(5:5) == "t") then
+        corn_lon = "glamf"
+        corn_lat = "gphif"
+        offset = (/ 0,0 /)
+      else if (nemo_lon(5:5) == "u") then
+        corn_lon = "glamv"
+        corn_lat = "gphiv"
+        offset = (/ 1,0 /)
+      else if (nemo_lon(5:5) == "v") then
+        corn_lon = "glamu"
+        corn_lat = "gphiu"
+        offset = (/ 0,1 /)
+      else
+        write(6,*) 'unknown nemo_lon name'
+        stop
+      endif
+
+      write(6,*) "processing " // trim(nemo_file)
+      call convertNEMO(nemo_file, nemo_lon, nemo_lat, corn_lon, corn_lat, &
+                       offset, nemogrid_file)
+
+    else
+
+      write(6,*) "processing regular grid " // trim(nemo_file)
+      call convertFLUX(nemo_file, nemo_lon, nemo_lat, &
+                       nemo_mask, nemo_mask_value, nemogrid_file)
+
+    endif
+
+    write(6,*) "processing regular grid"
+    call convertFLUX(input_file, input_lon, input_lat, &
+                     input_mask, input_mask_value, datagrid_file)
+
+  END SUBROUTINE convert
+  
+  ! ==============================================================================
+  
+  SUBROUTINE convertNEMO(grid_file_in, cent_lon, cent_lat, corn_lon, corn_lat, &
+                         off, grid_file_out)
+  
+    !-----------------------------------------------------------------------
+    !
+    !     This routine converts a NEMO coordinates.nc file to a remapping grid file.
+    !
+    
+    CHARACTER(char_len), INTENT(in) :: cent_lon, cent_lat, corn_lon, corn_lat
+    INTEGER (kind=int_kind), INTENT(in), DIMENSION(2) :: off
+    CHARACTER(char_len), INTENT(in) :: grid_file_out
+    CHARACTER(char_len), INTENT(in) :: grid_file_in
+
+    !-----------------------------------------------------------------------
+    !     module variables that describe the grid
+  
+    CHARACTER(char_len), parameter ::  &
+         grid_name = 'Remapped NEMO grid for SCRIP'
+  
+    !-----------------------------------------------------------------------
+    !     grid coordinates and masks
+  
+    REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:,:) :: &
+         clon, clat, &             ! expanded corner arrays
+         glam, &                   ! center longitude
+         gphi, &                   ! center latitude
+         glamc, &                  ! corner longitude
+         gphic                     ! corner latitude
+  
+    !-----------------------------------------------------------------------
+    !     other local variables
+  
+    INTEGER (kind=int_kind) :: i, j, n, iunit, im1, jm1, imid, isame, ic, jc
+    INTEGER (kind=int_kind) :: varid_lam, varid_phi, varid_lamc, varid_phic
+    INTEGER (kind=int_kind) :: jdim
+    INTEGER (kind=int_kind), dimension(4) :: grid_dimids  ! input fields have 4 dims
+    REAL (kind=dbl_kind) :: tmplon, dxt, dyt
+  
+    !-----------------------------------------------------------------------
+    !     read in grid info
+    !
+    !     For NEMO input grids, assume that variable names are glam, glamc etc.
+    !     Assume that 1st 2 dimensions of these variables are x and y directions.
+    !     These assumptions are made by NEMO, so should be valid for coordinates.nc.
+    !
+    ! write in nf90 calls (without error handling) and then think about 
+    ! making more readable by taking chunks into ncutil
+    !
+  
+    ncstat = nf90_open( grid_file_in, NF90_NOWRITE, ncid_in )
+    call netcdf_error_handler(ncstat)
+  
+    ! find dimids for 'glam'
+    ! use dimids to get dimlengths
+    ! allocate glam array
+    ! get glam from file 
+  
+    ncstat = nf90_inq_varid( ncid_in, cent_lon, varid_lam )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_inq_varid( ncid_in, corn_lon, varid_lamc )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_inq_varid( ncid_in, cent_lat, varid_phi )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_inq_varid( ncid_in, corn_lat, varid_phic )
+    call netcdf_error_handler(ncstat)
+  
+    ncstat = nf90_inquire_variable( ncid_in, varid_lam, dimids=grid_dimids(:) )
+    call netcdf_error_handler(ncstat)
+    DO jdim = 1, SIZE(grid_dims)
+       ncstat = nf90_inquire_dimension( ncid_in, grid_dimids(jdim),  &
+                                        len=grid_dims(jdim) )
+       call netcdf_error_handler(ncstat)
+    END DO
+    nx = grid_dims(1)
+    ny = grid_dims(2)
+    grid_size = nx * ny
+    WRITE(*,FMT='("Input grid dimensions are:",2i6)') nx, ny
+    
+    ! assume that dimensions are all the same as glam
+    ALLOCATE( glam(nx,ny), glamc(nx,ny), gphi(nx,ny), gphic(nx,ny) )
+    ncstat = nf90_get_var( ncid_in, varid_lam, glam(:,:) )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_get_var( ncid_in, varid_lamc, glamc(:,:) )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_get_var( ncid_in, varid_phi, gphi(:,:) )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_get_var( ncid_in, varid_phic, gphic(:,:) )
+    call netcdf_error_handler(ncstat)
+    
+    !-----------------------------------------------------------------------
+    ! - Mask is all ocean for now
+  
+    ALLOCATE( grid_imask(grid_size) )
+    grid_imask(:) = 1
+  
+    !-----------------------------------------------------------------------
+    ! corners are arranged as follows:    4 3
+    !                                     1 2
+    !
+    ! Assume that cyclic grids have 2 wrap columns in coordinates.nc
+    !  (this is the case for ORCA grids)
+    !
+  
+    ! -----------------------------------------------------------------------------
+    ! create a single pair of arrays for the corners where clon(1,1) corresponds
+    ! to the south west corner of a box containing glam(1,1)
+    ! various special cases then apply
+    !   bottom row:  assume clon(:,j) = clon(:,j+1)
+  
+    ALLOCATE ( clon(nx+1,ny+1), clat(nx+1,ny+1) )
+
+    ! first the easy internal points
+    DO j = 2,ny
+      DO i = 2,nx
+        ic = i + off(1) - 1
+        jc = j + off(2) - 1
+        clon(i,j) = glamc(ic,jc)
+        clat(i,j) = gphic(ic,jc)
+      ENDDO
+    ENDDO
+
+    ! then the tricky boundary points
+    imid = (nx-1)/2 + 1
+    DO j = 1,ny+1,ny
+      DO i = 1,nx+1,nx
+        ic = i + off(1) - 1
+        jc = j + off(2) - 1
+        if (ic == 0 .and. jc == 0) then
+          clon(i,j) = glamc(nx,1)
+          clat(i,j) = gphic(nx,1) - (gphic(nx,2)-gphic(nx,1))
+        else if (ic == nx+1 .and. jc == 0) then
+          clon(i,j) = glamc(1,1)
+          clat(i,j) = gphic(1,1) - (gphic(1,2)-gphic(1,1))
+        else if (ic == 0 .and. jc == ny+1) then
+          isame = 2*imid - nx + 1
+          clon(i,j) = glamc(isame,jc-1)
+          clat(i,j) = gphic(isame,jc-1)
+        else if (ic == nx+1 .and. jc == ny+1) then
+          isame = 2*imid
+          clon(i,j) = glamc(isame,jc-1)
+          clat(i,j) = gphic(isame,jc-1)
+        else if (ic == 0) then
+          clon(i,j) = glamc(nx,jc)
+          clat(i,j) = gphic(nx,jc)
+        else if (jc == 0) then
+          clon(i,j) = glamc(ic,1)
+          clat(i,j) = gphic(ic,1) - (gphic(ic,2)-gphic(ic,1))
+        else if (ic == nx+1) then
+          clon(i,j) = glamc(1,jc)
+          clat(i,j) = gphic(1,jc)
+        else if (jc == ny+1) then
+          isame = 2*imid - ic + 1
+          clon(i,j) = glamc(isame,jc-1)
+          clat(i,j) = gphic(isame,jc-1)
+        endif
+      ENDDO
+    ENDDO
+
+    ALLOCATE ( corner_lon(4,nx,ny), corner_lat(4,nx,ny) )
+  
+    ! top-right corner
+    corner_lon(3,:,:) = clon(2:nx+1,2:ny+1)
+    corner_lat(3,:,:) = clat(2:nx+1,2:ny+1)
+  
+    ! top-left corner
+    corner_lon(4,:,:) = clon(1:nx,2:ny+1)
+    corner_lat(4,:,:) = clat(1:nx,2:ny+1)
+  
+    ! bottom-right corner 
+    corner_lon(2,:,:) = clon(2:nx+1,1:ny)
+    corner_lat(2,:,:) = clat(2:nx+1,1:ny)
+  
+    ! bottom-left corner
+    corner_lon(1,:,:) = clon(1:nx,1:ny)
+    corner_lat(1,:,:) = clat(1:nx,1:ny)
+  
+  ! For [N, E, W]-ward extrapolation near the poles, should we use stereographic (or
+  ! similar) projection?  This issue will come for V,F interpolation, and for all
+  ! grids with non-cyclic grids.
+  
+    ! -----------------------------------------------------------------------------
+    !     correct for 0,2pi longitude crossings
+    !      (In practice this means putting all corners into 0,2pi range
+    !       and ensuring that no box corners are miles from each other.
+    !       3pi/2 is used as threshold - I think this is quite arbitrary.)
+  
+    corner_lon(:,:,:) = MODULO( corner_lon(:,:,:), circle )
+    DO n = 2, grid_corners
+       WHERE    ( corner_lon(n,:,:) - corner_lon(n-1,:,:) < -three*circle*0.25 )
+          corner_lon(n,:,:) = corner_lon(n,:,:) + circle
+       ELSEWHERE( corner_lon(n,:,:) - corner_lon(n-1,:,:) >  three*circle*0.25 )
+          corner_lon(n,:,:) = corner_lon(n,:,:) - circle
+       END WHERE
+    END DO
+  
+    ! -----------------------------------------------------------------------------
+    ! - put longitudes on smooth grid 
+  
+ !  call mouldlon(glam,nx,ny)
+ !  call mouldlon(corner_lon(1,:,:),nx,ny)
+ !  call mouldlon(corner_lon(2,:,:),nx,ny)
+ !  call mouldlon(corner_lon(3,:,:),nx,ny)
+ !  call mouldlon(corner_lon(4,:,:),nx,ny)
+
+    ! -----------------------------------------------------------------------------
+    ! - reshape for SCRIP input format
+  
+    ALLOCATE( grid_center_lon(grid_size), grid_center_lat(grid_size) )
+    
+    grid_center_lon(:) = RESHAPE( glam(:,:), (/ grid_size /) )
+    grid_center_lat(:) = RESHAPE( gphi(:,:), (/ grid_size /) )
+  
+    DEALLOCATE( glam, gphi, glamc, gphic )
+  
+    ALLOCATE( grid_corner_lon(4, grid_size), grid_corner_lat(4, grid_size) )
+  
+    grid_corner_lon(:,:) = RESHAPE( corner_lon(:,:,:), (/ 4, grid_size /) )
+    grid_corner_lat(:,:) = RESHAPE( corner_lat(:,:,:), (/ 4, grid_size /) )
+  
+    DEALLOCATE( corner_lon, corner_lat )
+  
+    CALL createSCRIPgrid(grid_file_out, grid_name)
+  
+  END SUBROUTINE convertNEMO
+  
+  ! ==============================================================================
+  
+  SUBROUTINE convertFLUX(grid_file_in, name_lon, name_lat, &
+                         name_mask, value_mask, grid_file_out)
+  
+    !-----------------------------------------------------------------------
+    !
+    !     This routine creates a remapping grid file from an input grid.
+    !
+    !-----------------------------------------------------------------------
+    
+    CHARACTER(char_len), INTENT(in) ::  &
+         grid_file_in, name_lon, name_lat, name_mask, grid_file_out
+    INTEGER (kind=int_kind) :: value_mask
+  
+    !-----------------------------------------------------------------------
+    !     variables that describe the grid
+  
+    CHARACTER(char_len), parameter ::  &
+         grid_name = 'Remapped regular grid for SCRIP'
+  
+    !-----------------------------------------------------------------------
+    !     grid coordinates (note that a flux file just has lon and lat)
+  
+    REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:) :: &
+         lam, phi
+    REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:,:) :: &
+         glam, &                   ! longitude
+         gphi, &                   ! latitude
+         glamc, &
+         gphic
+    REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:,:) :: mask
+  
+    !-----------------------------------------------------------------------
+    !     other local variables
+  
+    INTEGER (kind=int_kind) :: i, j, n, iunit, im1, jm1
+    INTEGER (kind=int_kind) :: varid_lam, varid_phi, varid_mask
+    INTEGER (kind=int_kind) :: jdim, nspace
+    INTEGER (kind=int_kind), dimension(4) :: grid_dimids  ! input fields have 4 dims
+    REAL (kind=dbl_kind) :: tmplon, dxt, dyt
+  
+    !-----------------------------------------------------------------------
+    !     read in grid info
+    !
+    !     For NEMO input grids, assume that variable names are glam, glamc etc.
+    !     Assume that 1st 2 dimensions of these variables are x and y directions.
+    !     These assumptions are made by NEMO, so should be valid for coordinates.nc.
+    !
+    ! write in nf90 calls (without error handling) and then think about 
+    ! making more readable by taking chunks into ncutil
+  
+    ncstat = nf90_open( grid_file_in, NF90_NOWRITE, ncid_in )
+    call netcdf_error_handler(ncstat)
+  
+    ! find dimids for 'glamt'
+    ! use dimids to get dimlengths
+    ! allocate glam array
+    ! get glam from file 
+  
+    ncstat = nf90_inq_varid( ncid_in, name_lat, varid_phi )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_inq_varid( ncid_in, name_lon, varid_lam )
+    call netcdf_error_handler(ncstat)
+  
+    ncstat = nf90_inquire_variable( ncid_in, varid_lam, ndims=nspace )
+    call netcdf_error_handler(ncstat)
+
+    if (nspace == 1) then
+      ncstat = nf90_inquire_variable( ncid_in, varid_lam, dimids=grid_dimids(:1) )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_inquire_variable( ncid_in, varid_phi, dimids=grid_dimids(2:) )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_inquire_dimension( ncid_in, grid_dimids(1), len=grid_dims(1) )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_inquire_dimension( ncid_in, grid_dimids(2), len=grid_dims(2) )
+      call netcdf_error_handler(ncstat)
+      nx = grid_dims(1)
+      ny = grid_dims(2)
+      grid_size = nx * ny
+      WRITE(*,FMT='("Input grid dimensions are:",2i6)') nx, ny
+    
+      ALLOCATE( lam(nx), phi(ny) )
+      write(6,*) 'double'
+      ncstat = nf90_get_var( ncid_in, varid_lam, lam )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_get_var( ncid_in, varid_phi, phi )
+      call netcdf_error_handler(ncstat)
+    
+      ALLOCATE( glam(nx,ny), gphi(nx,ny))
+      write(6,*) shape(lam),shape(phi)
+      glam(:,:) = SPREAD(lam,2,ny)
+      gphi(:,:) = SPREAD(phi,1,nx)
+    else
+
+      ncstat = nf90_inquire_variable( ncid_in, varid_lam, dimids=grid_dimids(:2) )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_inquire_dimension( ncid_in, grid_dimids(1), len=grid_dims(1) )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_inquire_dimension( ncid_in, grid_dimids(2), len=grid_dims(2) )
+      call netcdf_error_handler(ncstat)
+      nx = grid_dims(1)
+      ny = grid_dims(2)
+      grid_size = nx * ny
+      WRITE(*,FMT='("Input grid dimensions are:",2i6)') nx, ny
+    
+      ALLOCATE( glam(nx,ny), gphi(nx,ny))
+      ncstat = nf90_get_var( ncid_in, varid_lam, glam )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_get_var( ncid_in, varid_phi, gphi )
+      call netcdf_error_handler(ncstat)
+
+    endif
+    write(6,*) grid_size,nx,ny
+  
+    ALLOCATE(glamc(0:nx,0:ny), gphic(0:nx,0:ny) )
+
+    ! - for now a simple average to get top right box corners
+    ! - glamc(i,j), gphic(i,j) are top right coordinates of box containing 
+    ! - glam(i,j),gphi(i,j)
+    write(6,*) 'averaging'
+    write(6,*) size(gphic),size(gphi)
+    gphic(1:nx,1:ny-1) = 0.5*(gphi(:,1:ny-1)+gphi(:,2:ny))
+    write(6,*) size(glamc),size(glam)
+    glamc(1:nx-1,1:ny) = 0.5*(glam(1:nx-1,:)+glam(2:nx,:))
+  
+    ! - left and right column of longitudes 
+    write(6,*) 'columns'
+    glamc(nx,1:ny) = 1.5*glam(nx,:)-0.5*glam(nx-1,:)
+    glamc( 0,1:ny) = 1.5*glam(1,:)-0.5*glam(2,:)
+    glamc(nx, 0) = glamc(nx,1)
+    glamc( 0, 0) = glamc( 0,1)
+
+    ! - top and bottom row of latitudes by extrapolation
+    write(6,*) 'rows'
+    gphic(1:nx,ny) = 1.5*gphi(:,ny)-0.5*gphi(:,ny-1)
+    gphic(1:nx, 0) = 1.5*gphi(:,1)-0.5*gphi(:,2)
+    gphic( 0,ny) = gphic(1,ny)
+    gphic( 0, 0) = gphic(1, 0)
+
+    !-----------------------------------------------------------------------
+  
+    write(6,*) 'allocating'
+    ALLOCATE( grid_imask(grid_size) )
+    grid_imask(:) = 1
+    write(6,*) name_mask
+    if (trim(name_mask) /= "none") then
+      write(6,*) 'masking'
+      ncstat = nf90_inq_varid( ncid_in, name_mask, varid_mask )
+      call netcdf_error_handler(ncstat)
+      ALLOCATE( mask(nx,ny) )
+      write(6,*) 'reading mask'
+      ncstat = nf90_get_var( ncid_in, varid_mask, mask )
+      call netcdf_error_handler(ncstat)
+      write(6,*) 'setting mask'
+      WHERE ( RESHAPE(mask(:,:),(/ grid_size /)) < value_mask)
+        grid_imask = 0
+      END WHERE
+      write(6,*) 'masked'
+    END IF
+  
+    !-----------------------------------------------------------------------
+    ! corners are arranged as follows:    4 3
+    !                                     1 2
+  
+    ALLOCATE ( corner_lon(4,nx,ny), corner_lat(4,nx,ny) )
+  
+    ! - bottom-left corner
+    corner_lon(1,:,:) = glamc(0:nx-1, 0:ny-1 )
+    corner_lat(1,:,:) = gphic(0:nx-1, 0:ny-1 )
+  
+    ! - bottom-right corner 
+    corner_lon(2,:,:) = glamc(1:nx, 0:ny-1 )
+    corner_lat(2,:,:) = gphic(1:nx, 0:ny-1 )
+  
+    ! - top-right corner
+    corner_lon(3,:,:) = glamc(1:nx,1:ny)
+    corner_lat(3,:,:) = gphic(1:nx,1:ny)
+    write(6,*) corner_lat(3,nx-2:nx,ny)
+  
+    ! - top-left corner
+    corner_lon(4,:,:) = glamc(0:nx-1, 1:ny )
+    corner_lat(4,:,:) = gphic(0:nx-1, 1:ny )
+  
+  ! For [N, E, W]-ward extrapolation near the poles, should we use stereographic (or
+  ! similar) projection?  This issue will come for V,F interpolation, and for all
+  ! grids with non-cyclic grids.
+  
+    ! -----------------------------------------------------------------------------
+    !     correct for 0,2pi longitude crossings
+    !      (In practice this means putting all corners into 0,2pi range
+    !       and ensuring that no box corners are miles from each other.
+    !       3pi/2 is used as threshold - I think this is quite arbitrary.)
+  
+  ! corner_lon(:,:,:) = MODULO( corner_lon(:,:,:), circle )
+  ! DO n = 2, grid_corners
+  !    WHERE    ( corner_lon(n,:,:) - corner_lon(n-1,:,:) < -three*circle*0.25 )
+  !       corner_lon(n,:,:) = corner_lon(n,:,:) + circle
+  !    ELSEWHERE( corner_lon(n,:,:) - corner_lon(n-1,:,:) >  three*circle*0.25 )
+  !       corner_lon(n,:,:) = corner_lon(n,:,:) - circle
+  !    END WHERE
+  ! END DO
+  
+    ! -----------------------------------------------------------------------------
+    ! - reshape for SCRIP input format
+  
+    ALLOCATE( grid_center_lon(grid_size), grid_center_lat(grid_size) )
+    
+    grid_center_lon(:) = RESHAPE( glam(:,:), (/ grid_size /) )
+    grid_center_lat(:) = RESHAPE( gphi(:,:), (/ grid_size /) )
+  
+    DEALLOCATE( glam, gphi, glamc, gphic )
+  
+    ALLOCATE( grid_corner_lon(4, grid_size), grid_corner_lat(4, grid_size) )
+  
+    grid_corner_lon(:,:) = RESHAPE( corner_lon(:,:,:), (/ 4, grid_size /) )
+    grid_corner_lat(:,:) = RESHAPE( corner_lat(:,:,:), (/ 4, grid_size /) )
+  
+    DEALLOCATE( corner_lon, corner_lat )
+  
+    CALL createSCRIPgrid(grid_file_out, grid_name)
+  
+  END SUBROUTINE convertFLUX
+  
+  ! ==============================================================================
+  
+  SUBROUTINE mouldlon(lon_grid, nx, ny)
+
+    ! -----------------------------------------------------------------------------
+    ! - input variables
+
+    INTEGER, INTENT(in) :: nx, ny
+    REAL (kind=dbl_kind), INTENT(inout), DIMENSION(nx,ny) ::  &
+      lon_grid
+  
+    ! -----------------------------------------------------------------------------
+    ! - local variables
+
+    INTEGER :: ix, iy
+    REAL (kind=dbl_kind), DIMENSION(:,:), ALLOCATABLE ::  &
+      dlon
+    REAL :: step
+
+    ! -----------------------------------------------------------------------------
+    ! - try to eliminate any 360 degree steps in a grid of longitudes
+
+    ALLOCATE(dlon(nx,ny))
+
+    step = 0.75*circle
+    dlon(:,:) = 0
+    dlon(2:,:) = lon_grid(2:,:) - lon_grid(:nx-1,:)
+    WHERE (dlon > -step .AND. dlon < step)
+      dlon = 0.0
+    ELSEWHERE
+      dlon = -SIGN(circle,dlon)
+    END WHERE
+
+    ! - close your eyes this is nasty
+    DO ix = 2,nx
+      dlon(ix,:) = dlon(ix,:) + dlon(ix-1,:)
+    END DO
+    lon_grid = lon_grid + dlon
+
+  END SUBROUTINE mouldlon
+  
+  ! ==============================================================================
+  
+  SUBROUTINE createSCRIPgrid(grid_file_out, grid_name)
+  
+    ! -----------------------------------------------------------------------------
+    ! - input variables
+  
+    CHARACTER(char_len), INTENT(in) ::  &
+         grid_name, grid_file_out
+  
+    ! -----------------------------------------------------------------------------
+    ! - local variables that describe the netcdf file
+  
+    INTEGER (kind=int_kind) :: &
+         nc_grid_id,       &   ! netCDF grid dataset id
+         nc_gridsize_id,   &   ! netCDF grid size dim id
+         nc_gridcorn_id,   &   ! netCDF grid corner dim id
+         nc_gridrank_id,   &   ! netCDF grid rank dim id
+         nc_griddims_id,   &   ! netCDF grid dimensions id
+         nc_grdcntrlat_id, &   ! netCDF grid center lat id
+         nc_grdcntrlon_id, &   ! netCDF grid center lon id
+         nc_grdimask_id,   &   ! netCDF grid mask id
+         nc_gridarea_id,   &   ! netCDF grid area id
+         nc_grdcrnrlat_id, &   ! netCDF grid corner lat id
+         nc_grdcrnrlon_id      ! netCDF grid corner lon id
+  
+    ! -----------------------------------------------------------------------------
+    ! - create netCDF dataset for this grid
+    ! - rewrite in nf90 
+    ! - (bring out functional blocks into ncclear for readability)
+  
+    ncstat = nf90_create (grid_file_out, NF90_CLOBBER, nc_grid_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att (nc_grid_id, NF90_GLOBAL, 'title', grid_name)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid size dimension
+  
+    ncstat = nf90_def_dim (nc_grid_id, 'grid_size', grid_size, nc_gridsize_id)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid rank dimension
+  
+    ncstat = nf90_def_dim (nc_grid_id, 'grid_rank', grid_rank, nc_gridrank_id)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid corner dimension
+  
+    ncstat = nf90_def_dim (nc_grid_id, 'grid_corners', grid_corners, nc_gridcorn_id)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid dim size array
+  
+    ncstat = nf90_def_var(nc_grid_id, 'grid_dims', NF90_INT, nc_gridrank_id, nc_griddims_id)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid mask
+  
+    ncstat = nf90_def_var(nc_grid_id, 'grid_imask', NF90_INT, &
+                          nc_gridsize_id, nc_grdimask_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att(nc_grid_id, nc_grdimask_id, 'units', 'unitless')
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid center latitude array
+  
+    ncstat = nf90_def_var(nc_grid_id, 'grid_center_lat', NF90_DOUBLE, &
+                          nc_gridsize_id, nc_grdcntrlat_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att(nc_grid_id, nc_grdcntrlat_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid center longitude array
+  
+    ncstat = nf90_def_var(nc_grid_id, 'grid_center_lon', NF90_DOUBLE, &
+                          nc_gridsize_id, nc_grdcntrlon_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att(nc_grid_id, nc_grdcntrlon_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid corner latitude array
+  
+    grid_dim_ids = (/ nc_gridcorn_id, nc_gridsize_id /)
+    ncstat = nf90_def_var(nc_grid_id, 'grid_corner_lat', NF90_DOUBLE, &
+                          grid_dim_ids, nc_grdcrnrlat_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att(nc_grid_id, nc_grdcrnrlat_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid corner longitude array
+  
+    ncstat = nf90_def_var(nc_grid_id, 'grid_corner_lon', NF90_DOUBLE, &
+                          grid_dim_ids, nc_grdcrnrlon_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att(nc_grid_id, nc_grdcrnrlon_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! end definition stage
+  
+    ncstat = nf90_enddef(nc_grid_id)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! write grid data
+  
+    ncstat = nf90_put_var(nc_grid_id, nc_griddims_id, grid_dims)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_var(nc_grid_id, nc_grdimask_id, grid_imask)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_var(nc_grid_id, nc_grdcntrlat_id, grid_center_lat)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_var(nc_grid_id, nc_grdcntrlon_id, grid_center_lon)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_var(nc_grid_id, nc_grdcrnrlat_id, grid_corner_lat)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_var(nc_grid_id, nc_grdcrnrlon_id, grid_corner_lon)
+    call netcdf_error_handler(ncstat)
+  
+    ncstat = nf90_close(nc_grid_id)
+    call netcdf_error_handler(ncstat)
+  
+    DEALLOCATE( grid_imask, grid_center_lon, grid_center_lat, &
+                grid_corner_lon, grid_corner_lat )
+  
+  
+  END SUBROUTINE createSCRIPgrid
+  
+END MODULE scripgrid_mod
+
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripinterp.F90
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripinterp.F90	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripinterp.F90	(revision 2352)
@@ -0,0 +1,23 @@
+! ==========================================================================
+
+program scripinterp
+
+  use scripinterp_mod
+
+  character (char_len) ::  nm_in
+#if defined ARGC
+  integer :: iargc
+  external iargc
+
+  if (iargc() == 1) then
+    call getarg(1, nm_in)
+    call process_grid(nm_in)
+  else
+    write(6,*) 'need the name of an input namelist'
+  endif
+#else
+  write(6,*) 'enter the name of an input namelist'
+  read(5,*) nm_in
+#endif
+
+end program scripinterp
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripinterp_mod.F90
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripinterp_mod.F90	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripinterp_mod.F90	(revision 2352)
@@ -0,0 +1,1031 @@
+! **************************************************************************
+
+  module scripinterp_mod
+
+! ==========================================================================
+
+  use kinds_mod    ! defines common data types
+  use constants    ! defines common constants
+  use iounits      ! I/O unit manager
+  use netcdf
+  use netcdf_mod   ! netcdf I/O stuff
+  use grids        ! module containing grid info
+  use remap_vars   ! module containing remapping info
+  use remap_mod    ! module containing remapping routines
+  use remap_read   ! routines for reading remap files
+
+  implicit none
+
+  real(kind=dbl_kind), dimension(:), allocatable ::   &
+    grid_out
+
+  integer(kind=int_kind) ::                           &  ! netCDF ids for files and arrays
+          ncstat, nc_outfile_id, nc_infile_id
+  integer (kind=int_kind), dimension(4) ::    &
+      input_dims, input_dimids, input_count
+  real (kind=dbl_kind), dimension(:), allocatable ::   &
+      scale
+  integer (kind=int_kind), dimension(:), allocatable ::        &
+      nc_xysize_id, nc_gridsize_id, nc_gridsize,           &
+      nc_variable_id
+  integer :: nc_lon_id, nc_lat_id, nc_array_id
+
+  character (char_len) ::  &
+          map_name      ! name for mapping from grid1 to grid2
+  character (1), parameter ::  &
+          separator = '|'
+  
+  ! - input namelist variables
+  
+  character (char_len) ::  &
+    input_file,            &  ! filename containing input fields
+    interp_file,           &  ! filename containing remap data (map1)
+    input_name                ! name of variable to grid
+  integer (kind=int_kind), dimension(4) :: &
+    input_stride,  &          ! how much of input array to process
+    input_start,   &          ! where to start
+    input_stop                ! and where to stop
+  character (char_len), dimension(4) ::  &
+    input_vars                ! input variables to be copied
+  
+  ! - output namelist variables
+  
+  character (char_len) ::  &
+    output_file,           &  ! filename for test results
+    output_mode,           &  ! 'create' or 'append'
+    output_name,           &  ! name of new grid variable
+    output_lat,            &  ! as it says
+    output_lon,            &  ! as it says
+    output_ydir               ! choose to invert output arrays in y direction
+  character (char_len), dimension(4) ::  &
+    output_dims,           &    ! name of new grid variable
+    output_vars                 ! variables to copy
+  character (char_len), dimension(10) ::  &
+    output_attributes,     &  ! attributes of stuff in output file
+    output_scaling             ! scaling factor to apply to input data to get
+                               ! correct units in output file
+contains
+
+! ==========================================================================
+
+  subroutine process_grid(nm_in)
+  
+    !-----------------------------------------------------------------------
+    ! - dummy variables
+
+    character (char_len) ::  &
+      nm_in                    ! name of input namelist file
+  
+    !-----------------------------------------------------------------------
+    ! - local variables
+
+    integer (kind=int_kind), dimension(4) ::    &
+        astart, acount, plus_one
+    integer (kind=int_kind), dimension(3) ::    &
+        write_dims
+    integer (kind=int_kind) ::                  &
+      i1, i2, jdim, n, nx, ny, nloop,           &
+      nc_input_id, nc_input_rank,               &
+      vstart, vstride, numv
+
+    real (kind=dbl_kind), dimension(:), allocatable  ::    &
+      grid1_array
+    real (kind=dbl_kind), dimension(:,:), allocatable  ::    &
+      var_out
+
+    plus_one(:) = 1
+
+    !-----------------------------------------------------------------------
+
+    call read_mappings(nm_in)
+
+    !-----------------------------------------------------------------------
+    ! - read input grid
+    ! - WARNING - lots of assumptions here at the moment
+  
+    ncstat = nf90_open( input_file, NF90_NOWRITE, nc_infile_id )
+    call netcdf_error_handler(ncstat,"open")
+  
+    ncstat = nf90_inq_varid( nc_infile_id, input_name, nc_input_id )
+    call netcdf_error_handler(ncstat,"inq_varid")
+  
+    input_dims(:) = 0
+    ncstat = nf90_inquire_variable( nc_infile_id, nc_input_id,   &
+                  ndims=nc_input_rank, dimids=input_dimids(:) )
+    call netcdf_error_handler(ncstat,"inquire_variable")
+
+    do jdim = 1,nc_input_rank
+      ncstat = nf90_inquire_dimension(nc_infile_id,              &
+                    input_dimids(jdim), len=input_dims(jdim) )
+      call netcdf_error_handler(ncstat,"inquire_dimension")
+    enddo
+  
+    ! - dimids seem to be returned in storage order so the outer dimension of 
+    ! - the array as described by the netcdf file becomes the first dimension
+    ! - as far as f90 is concerned (confused? you will be!)
+
+    do jdim = 1,nc_input_rank
+      if (input_stop(jdim) == 0) then
+        input_stop(jdim) = input_dims(jdim)
+      endif
+      input_count(jdim) = input_stop(jdim) - input_start(jdim) + 1
+    enddo
+
+    ! - rashly we assume x followed by y
+    nx = input_dims(1)
+    ny = input_dims(2)
+    write(*,fmt='("Input grid dimensions are:",2i6)') nx, ny
+    if (nx*ny /= grid1_size) then
+      write(6,*) "mismatch between input grid and remap data"
+      stop
+    endif
+
+    ! - calculate number of horizontal slices to process
+    ! - at the moment this is not very general and will only work with 3 dimensions
+
+    acount(1:nc_input_rank) = &
+             (input_stop(1:nc_input_rank)-input_start(1:nc_input_rank)+1) / &
+             input_stride(1:nc_input_rank)
+    nloop = 1
+    do jdim = 1,nc_input_rank
+      nloop = nloop*acount(jdim)
+    enddo
+    nloop = nloop/grid1_size
+    write(6,*) "total slices requested: ",nloop
+
+    vstart = input_start(nc_input_rank)            ! ie extra var has outer dimension
+    vstride = input_stride(nc_input_rank)
+
+    ! - in general we cant read in the whole array so do it slice by slice
+    ! - slow but sure
+
+    write(6,*) "allocating input and output grids"
+    allocate( grid1_array(grid1_size))
+    allocate( grid_out(grid2_size) )
+
+    numv = 0
+    do n = 1,4
+      if (trim(input_vars(n)) /= '-' .and. &
+          trim(output_vars(n)) /= '-') numv = numv + 1
+    enddo
+
+    write_dims(1) = grid2_dims(1)
+    write_dims(2) = grid2_dims(2)
+    write_dims(3) = nloop
+    call define_grid(write_dims(1:3) , 2+numv)
+
+    astart(:) = input_start(:)
+    astart(3) = astart(3) - input_stride(3)
+    acount(:) = 1
+    acount(1) = nx
+    acount(2) = ny
+
+    do n = 1,nloop
+
+      write(6,*) "processing slice: ",n
+      astart(3) = astart(3) + input_stride(3)
+      ncstat = nf90_get_var(nc_infile_id, nc_input_id, grid1_array,  &
+                            start=astart(1:nc_input_rank),              &
+                            count=acount(1:nc_input_rank))
+      call netcdf_error_handler(ncstat,"get_var")
+
+      call calculate_grid(grid1_array, grid_out)
+
+      call write_grid(grid_out, n, write_dims(1:2) , 2)
+
+    enddo
+
+    ! ---------------------------------------------------------------------
+    ! - now for any extra variables to copy
+
+    if (numv > 0) then
+
+      write(6,*) "reading ",numv," extra variables"
+      allocate( var_out(nloop,numv) )
+  
+      do n = 1,numv
+        write(6,*) "looking for variable: ",trim(input_vars(n))
+        ncstat = nf90_inq_varid( nc_infile_id, trim(input_vars(n)), nc_input_id )
+        call netcdf_error_handler(ncstat,"inq_varid")
+      
+        input_dims(:) = 0
+        ncstat = nf90_inquire_variable( nc_infile_id, nc_input_id,   &
+                      ndims=nc_input_rank, dimids=input_dimids(:) )
+        call netcdf_error_handler(ncstat,"inquire_variable")
+  
+        if (nc_input_rank /= 1) then
+          write(6,*) 'sorry, only rank 1 variables can be copied'
+          cycle
+        endif
+        ncstat = nf90_inquire_dimension(nc_infile_id,              &
+                      input_dimids(1), len=input_dims(1) )
+        call netcdf_error_handler(ncstat,"inquire_dimension")
+  
+        ncstat = nf90_get_var(nc_infile_id, nc_input_id, var_out(1:nloop,n),  &
+                              start=(/ vstart /), stride=(/ vstride /))
+        call netcdf_error_handler(ncstat,"get_var")
+      enddo
+  
+      call write_extra(var_out, numv+2)
+      deallocate(var_out)
+
+    endif
+
+    ncstat = nf90_close(nc_outfile_id)
+    call netcdf_error_handler(ncstat,"out close")
+    ncstat = nf90_close(nc_infile_id)
+    call netcdf_error_handler(ncstat,"in close")
+
+    ! ---------------------------------------------------------------------
+
+    deallocate( grid1_array, grid_out)
+
+    ! ---------------------------------------------------------------------
+
+  end subroutine process_grid
+
+  ! ==========================================================================
+
+  subroutine define_grid(thedims, therank)
+
+    !-----------------------------------------------------------------------
+    ! - dummy variables
+    
+    integer (kind=int_kind) :: &
+      therank
+    integer (kind=int_kind), dimension(therank) :: &
+      thedims
+
+    !-----------------------------------------------------------------------
+    ! - local variables
+
+    integer ::               &
+      k, n, ilon, ilat, icolon, i1, i2, natt, nvar, id, jd, kd, nd
+    character (char_len) ::  &
+      aname, vname, att
+    real (kind=dbl_kind) ::   s
+
+    ! - netcdf variables
+
+    integer :: xtype
+
+    !-----------------------------------------------------------------------
+    ! -  define grid size dimensions
+  
+    allocate(nc_xysize_id(grid2_rank))
+    allocate(nc_gridsize_id(therank))
+    allocate(nc_gridsize(therank))
+    allocate(nc_variable_id(therank-2))
+    
+    !-----------------------------------------------------------------------
+    ! - setup a NetCDF file for output
+  
+    xtype = NF90_FLOAT
+
+    write(6,*) 'creating output file'
+    ncstat = nf90_create (output_file, NF90_CLOBBER, nc_outfile_id)
+    call netcdf_error_handler(ncstat,"create")
+  
+    write(6,*) 'setting global attributes'
+    ncstat = nf90_put_att(nc_outfile_id, NF90_GLOBAL, 'title', map_name)
+    call netcdf_error_handler(ncstat,"put_att")
+  
+    write(6,*) 'setting dimensions'
+    do n=1,therank
+      if (n .eq. therank .and. therank .gt. 2) then
+        write(6,*) '    unlimited dim ',trim(output_dims(n)),' size: ',thedims(n)
+        ncstat = nf90_def_dim (nc_outfile_id, output_dims(n), NF90_UNLIMITED, &
+                               nc_gridsize_id(n))
+      else
+        write(6,*) '    dim ',trim(output_dims(n)),' size: ',thedims(n)
+        ncstat = nf90_def_dim (nc_outfile_id, output_dims(n), thedims(n), &
+                               nc_gridsize_id(n))
+      endif
+      call netcdf_error_handler(ncstat,"def_dim")
+    end do
+    nc_gridsize(:) = thedims(1:therank)
+
+    ! - at the moment there is an assumption here that the ordering is (lon,lat)
+
+    ilon = 1
+    ilat = 2
+    nc_xysize_id(1) = nc_gridsize_id(ilon)
+    nc_xysize_id(2) = nc_gridsize_id(ilat)
+
+    ! ----------------------------------------------------------------
+    ! -  define grid center longitude array
+  
+    write(6,*) 'defining longitude variable'
+    ncstat = nf90_def_var (nc_outfile_id, output_lon,   &
+                         xtype, nc_xysize_id,   &
+                         nc_lon_id)
+    call netcdf_error_handler(ncstat,"def_var")
+  
+    ncstat = nf90_put_att (nc_outfile_id, nc_lon_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat,"put_att")
+  
+    ! ----------------------------------------------------------------
+    ! -  define grid center latitude array
+  
+    write(6,*) 'defining latitude variable'
+    ncstat = nf90_def_var (nc_outfile_id, output_lat,     &
+                         xtype, nc_xysize_id,   &
+                         nc_lat_id)
+    call netcdf_error_handler(ncstat,"def_var")
+  
+    ncstat = nf90_put_att (nc_outfile_id, nc_lat_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat,"put_att")
+  
+    ! ----------------------------------------------------------------
+    ! -  define copy variables array
+  
+    write(6,*) 'defining copy variables'
+    do n = 3,therank
+      ncstat = nf90_def_var (nc_outfile_id, output_vars(n-2),   &
+                           xtype, nc_gridsize_id(n),    &
+                           nc_variable_id(n-2))
+      call netcdf_error_handler(ncstat,"def_var")
+    enddo
+  
+    ! ----------------------------------------------------------------
+    ! -  define output array
+  
+    write(6,*) 'defining grid variable'
+    ncstat = nf90_def_var (nc_outfile_id, output_name,               &
+                         xtype, nc_gridsize_id,    &
+                         nc_array_id)
+    call netcdf_error_handler(ncstat,"def_var")
+  
+    ! ----------------------------------------------------------------
+    ! - output attributes has to come after all other definitions
+    ! - this code currently a bit murky, needs a rewrite
+  
+    ncstat = nf90_inquire (nc_outfile_id, nVariables=nvar)
+    call netcdf_error_handler(ncstat,"inquire")
+    do n = 1,10
+      att = trim(output_attributes(n))
+      natt = len(att)
+      if (att /= '-') then
+        i1 = index(att,separator)
+        aname = att(1:i1-1)
+        do k = 1,nvar
+          ncstat = nf90_inquire_variable(nc_outfile_id, k, vname)
+          call netcdf_error_handler(ncstat,"inquire_variable")
+          if (vname == aname) then
+            i2 = index(att,separator,.true.)
+            ncstat = nf90_put_att (nc_outfile_id, k, &
+                                   att(i1+1:i2-1), att(i2+1:natt))
+            call netcdf_error_handler(ncstat,"put_att")
+            exit      ! from innermost do
+          endif
+        enddo
+      endif
+    enddo
+  
+    ! output scaling
+
+    allocate (scale(nvar))
+    scale(:) = 1.0
+
+    do n = 1,10
+      att = trim(output_scaling(n))
+      natt = len(att)
+      if (att /= '-') then
+        i1 = index(att,separator)
+        aname = att(1:i1-1)
+        do k = 1,nvar
+          ncstat = nf90_inquire_variable(nc_outfile_id, k, vname)
+          call netcdf_error_handler(ncstat,"inquire_variable")
+          if (vname == aname) then
+            i2 = index(att,separator,.true.)
+            read(att(i2+1:natt),*) scale(k)
+            call netcdf_error_handler(ncstat,"put_att")
+            exit      ! from innermost do
+          endif
+        enddo
+      endif
+    enddo
+  
+    ! ----------------------------------------------------------------
+    ! -  end definition stage
+  
+    ncstat = nf90_enddef(nc_outfile_id)
+    call netcdf_error_handler(ncstat,"enddef")
+ 
+  end subroutine define_grid
+
+  ! ==========================================================================
+
+  subroutine write_grid(thegrid, thelevel, thedims, therank)
+
+    !-----------------------------------------------------------------------
+    ! - dummy variables
+    
+    integer (kind=int_kind), intent(in) :: &
+      therank, thelevel
+    real (kind=dbl_kind), dimension(:), intent(in) ::   &
+      thegrid
+    integer (kind=int_kind), dimension(therank) :: &
+      thedims
+
+    !-----------------------------------------------------------------------
+    ! - local variables
+
+    integer ::               &
+      k, n, ilon, ilat, icolon, j1, j2, dj, natt, nvar, id, jd, kd, nd
+    character (char_len) ::  &
+      aname, vname, att
+    real (kind=dbl_kind), dimension(:,:,:), allocatable ::   &
+      data
+    real (kind=dbl_kind) ::   s
+    real (kind=dbl_kind), parameter :: todeg = 57.295779513082323
+    integer (kind=int_kind), dimension(3) ::   &
+      start
+
+    ! - netcdf variables
+
+    integer :: xtype
+
+    !-----------------------------------------------------------------------
+    ! - write results to NetCDF file
+  
+    allocate (data(thedims(1),thedims(2),1))
+    if (output_ydir .eq. 'invert') then
+      j1 = thedims(2)
+      j2 = 1
+      dj = -1
+    else
+      j1 = 1
+      j2 = thedims(2)
+      dj = 1
+    endif
+
+    if (thelevel .eq. 1) then
+
+      ! -  grid center latitude array
+  
+      write(6,*) 'writing latitude variable'
+      s = scale(nc_lat_id)
+      nd = 0
+      do jd = j1,j2,dj
+        do id =1,thedims(1)
+          nd = nd + 1
+          data(id,jd,1) = s*todeg*grid2_center_lat(nd)
+        enddo
+      enddo
+      ncstat = nf90_put_var(nc_outfile_id, nc_lat_id, data(:,:,1))
+      call netcdf_error_handler(ncstat,"put_var")
+  
+      ! -  grid center longitude array
+  
+      write(6,*) 'writing longitude variable'
+      s = scale(nc_lon_id)
+      nd = 0
+      do jd = j1,j2,dj
+        do id =1,thedims(1)
+          nd = nd + 1
+          data(id,jd,1) = s*todeg*grid2_center_lon(nd)
+        enddo
+      enddo
+      ncstat = nf90_put_var(nc_outfile_id, nc_lon_id, data(:,:,1))
+      call netcdf_error_handler(ncstat,"put_var")
+
+    endif
+
+    !-----------------------------------------------------------------------
+    ! -  new grid
+
+    write(6,*) 'writing grid variable'
+    n = therank
+    s = scale(nc_array_id)
+    nd = 0
+    do jd = j1,j2,dj
+      do id =1,thedims(1)
+        nd = nd + 1
+        data(id,jd,1) = thegrid(nd)
+      enddo
+    enddo
+    write(6,*) 'scaling data '
+    data(:,:,1) = s*data(:,:,1)
+    start(:) = (/ 1, 1, thelevel /)
+    ncstat = nf90_put_var(nc_outfile_id, nc_array_id, data, start)
+    call netcdf_error_handler(ncstat,"put_var")
+    deallocate(data)
+
+  end subroutine write_grid
+
+  ! ==========================================================================
+
+  subroutine write_extra(thevars, therank)
+
+    real (kind=dbl_kind), dimension(:,:), intent(in) ::   &
+      thevars
+    real (kind=dbl_kind), dimension(:), allocatable ::   &
+      thedata
+    integer (kind=int_kind), intent(in) :: &
+      therank
+    real (kind=dbl_kind) ::   s
+    integer :: n
+
+    allocate( thedata(size(thevars,1)) )
+
+    ! -  copy variable arrays
+
+    write(6,*) 'writing copy variables'
+    do n = 3,therank
+      s = scale(nc_variable_id(n-2))
+      thedata(:) = s*thevars(:,n-2)
+      ncstat = nf90_put_var(nc_outfile_id, nc_variable_id(n-2), thedata)
+      call netcdf_error_handler(ncstat,"put_var")
+    enddo
+
+    deallocate( thedata )
+
+  end subroutine write_extra
+
+  ! ==========================================================================
+
+  subroutine close_grid()
+
+  !     close netCDF file
+  
+    write(6,*) 'closing file'
+    ncstat = nf90_close(nc_outfile_id)
+    call netcdf_error_handler(ncstat,"close")
+  
+  end subroutine close_grid
+
+  ! ==========================================================================
+
+  subroutine read_mappings(nm_in)
+
+    !-----------------------------------------------------------------------
+    ! - dummy variables
+
+    character (char_len) ::  &
+      nm_in                    ! name of input namelist file
+  
+    !-----------------------------------------------------------------------
+    ! - local variables
+  
+    character (char_len) ::   &
+              dim_name    ! netCDF dimension name
+  
+    integer (kind=int_kind) ::     &
+        iunit                                                ! unit number for namelist file
+  
+    !-----------------------------------------------------------------------
+    ! - namelist block
+
+    namelist /interp_inputs/ input_file, interp_file, input_name, &
+                             input_stride, input_start, input_stop, &
+                             input_vars
+    namelist /interp_outputs/ output_dims, output_file, output_mode, output_name, &
+                              output_lat, output_lon, output_ydir,  &
+                              output_scaling, output_vars, output_attributes
+  
+    !-----------------------------------------------------------------------
+    ! - read namelist for file and mapping info
+  
+    input_stride(:) = 1
+    input_start(:) = 1
+    input_stop(:) = 0
+    output_scaling(:) = '-'
+    input_vars(:) = '-'
+    output_lon = '-'
+    output_lat = '-'
+    output_vars(:) = '-'
+    output_ydir = 'none'
+    output_attributes(:) = '-'
+
+    call get_unit(iunit)
+    open(iunit, file=nm_in, status='old', form='formatted')
+    read(iunit, nml=interp_inputs)
+    read(iunit, nml=interp_outputs)
+    call release_unit(iunit)
+    write(*,nml=interp_inputs)
+    write(*,nml=interp_outputs)
+    if (trim(output_mode) == "create") then
+      if (trim(output_lon) == '-' .or. trim(output_lat) == '-') then
+        write(6,*) 'if creating, need to supply lon and lat names'
+        stop
+      endif
+    endif
+
+    !-----------------------------------------------------------------------
+    ! - read remapping data
+    ! - via the scrip package this sets variables:
+    !    grid1_size, grid2_size:     sizes of input and output grids
+    !    grid1_mask, grid2_mask:     masks
+    !    grid1_rank, grid2_rank:     ranks
+  
+    call read_remap(map_name, interp_file)
+  
+  end subroutine read_mappings
+
+  ! ==========================================================================
+
+  subroutine calculate_grid(grid1_array, grid2_array)
+
+    !-----------------------------------------------------------------------
+    ! - dummy variables
+
+    real (kind=dbl_kind), intent(in), dimension(:) ::    &
+      grid1_array
+    real (kind=dbl_kind), intent(out), dimension(:) ::    &
+      grid2_array
+
+    !-----------------------------------------------------------------------
+    ! - local variables
+
+    integer (kind=int_kind), dimension(:), allocatable :: &
+        grid1_imask, grid2_imask, grid2_count
+
+    real (kind=dbl_kind), dimension(:), allocatable :: &
+        grid1_tmp,           &
+        grad1_lat,           &
+        grad1_lon,           &
+        grad1_latlon,        &
+        grad1_lat_zero,      &
+        grad1_lon_zero,      &
+        grid2_tmp1,           &
+        grid2_tmp2
+
+    real (kind=dbl_kind) ::  &
+        delew, delns            ! variables for computing bicub gradients
+
+    integer (kind=int_kind) ::                          &
+        i,j,n,imin,imax,idiff,                          &
+        ip1,im1,jp1,jm1,nx,ny,                          &  ! for computing bicub gradients
+        in,is,ie,iw,ine,inw,ise,isw
+
+    logical, parameter :: lat_gradient = .false.
+  
+    write(6,*) 'starting'
+
+    !-----------------------------------------------------------------------
+    ! - allocate arrays
+  
+    allocate (grid1_tmp      (grid1_size),   &
+              grad1_lat      (grid1_size),    &
+              grad1_lon      (grid1_size),    &
+              grad1_lat_zero (grid1_size),    &
+              grad1_lon_zero (grid1_size),    &
+              grid1_imask    (grid1_size),   &
+              grid2_tmp1     (grid2_size),   &
+              grid2_tmp2     (grid2_size),   &
+              grid2_imask    (grid2_size),   &
+              grid2_count    (grid2_size))
+  
+    write(6,*) 'allocated'
+    write(6,*) grid1_size,grid2_size
+
+    grid1_imask(:) = 1
+    grid2_imask(:) = 1
+    where (grid1_mask)
+      grid1_imask = 1
+    elsewhere
+      grid1_imask = 0
+    endwhere
+    where (grid2_mask)
+      grid2_imask = 1
+    elsewhere
+      grid2_imask = 0
+    endwhere
+
+    write(6,*) 'masked'
+
+    grad1_lat_zero = zero
+    grad1_lon_zero = zero
+    nx = input_dims(1)
+    ny = input_dims(2)
+    write(6,*) nx,ny
+  
+    !-----------------------------------------------------------------------
+    ! - if bicubic, we need 3 gradients in logical space
+  
+    if (map_type == map_type_bicubic) then
+  
+      write(6,*) 'bicubic'
+      write(6,*) grid1_size
+
+      allocate (grad1_latlon (grid1_size)) 
+  
+      do n=1,grid1_size
+  
+        grad1_lat(n) = zero
+        grad1_lon(n) = zero
+        grad1_latlon(n) = zero
+  
+!       if (n.ge.8000) write(6,*) 0,grid1_mask(n),nx
+        if (grid1_mask(n)) then
+  
+          delew = half
+          delns = half
+  
+          j = (n-1)/nx + 1
+          i = n - (j-1)*nx
+  
+          ip1 = i+1
+          im1 = i-1
+          jp1 = j+1
+          jm1 = j-1
+  
+          if (ip1 > nx) ip1 = ip1 - nx
+          if (im1 < 1 ) im1 = nx
+          if (jp1 > ny) then
+            jp1 = j
+            delns = one
+          endif
+          if (jm1 < 1 ) then
+            jm1 = j
+            delns = one
+          endif
+  
+          in  = (jp1-1)*nx + i
+          is  = (jm1-1)*nx + i
+          ie  = (j  -1)*nx + ip1
+          iw  = (j  -1)*nx + im1
+  
+          ine = (jp1-1)*nx + ip1
+          inw = (jp1-1)*nx + im1
+          ise = (jm1-1)*nx + ip1
+          isw = (jm1-1)*nx + im1
+  
+          ! -  compute i-gradient
+  
+          if (.not. grid1_mask(ie)) then
+            ie = n
+            delew = one
+          endif
+          if (.not. grid1_mask(iw)) then
+            iw = n
+            delew = one
+          endif
+   
+          grad1_lat(n) = delew*(grid1_array(ie) - grid1_array(iw))
+!         if (n.ge.8000) write(6,*) 1,grad1_lat(n)
+  
+          ! -  compute j-gradient
+  
+          if (.not. grid1_mask(in)) then
+            in = n
+            delns = one
+          endif
+          if (.not. grid1_mask(is)) then
+            is = n
+            delns = one
+          endif
+   
+          grad1_lon(n) = delns*(grid1_array(in) - grid1_array(is))
+!         if (n.ge.8000) write(6,*) 2,grad1_lon(n)
+  
+          ! -  compute ij-gradient
+  
+          delew = half
+          if (jp1 == j .or. jm1 == j) then
+            delns = one
+          else 
+            delns = half
+          endif
+  
+          if (.not. grid1_mask(ine)) then
+            if (in /= n) then
+              ine = in
+              delew = one
+            else if (ie /= n) then
+              ine = ie
+              inw = iw
+              if (inw == n) delew = one
+              delns = one
+            else
+              ine = n
+              inw = iw
+              delew = one
+              delns = one
+            endif
+          endif
+  
+          if (.not. grid1_mask(inw)) then
+            if (in /= n) then
+              inw = in
+              delew = one
+            else if (iw /= n) then
+              inw = iw
+              ine = ie
+              if (ie == n) delew = one
+              delns = one
+            else
+              inw = n
+              ine = ie
+              delew = one
+              delns = one
+            endif
+          endif
+  
+          grad1_lat_zero(n) = delew*(grid1_array(ine) - grid1_array(inw))
+!         if (n.ge.8000) write(6,*) 3,grad1_lat_zero(n)
+  
+          if (.not. grid1_mask(ise)) then
+            if (is /= n) then
+              ise = is
+              delew = one
+            else if (ie /= n) then
+              ise = ie
+              isw = iw
+              if (isw == n) delew = one
+              delns = one
+            else
+              ise = n
+              isw = iw
+              delew = one
+              delns = one
+            endif
+          endif
+  
+          if (.not. grid1_mask(isw)) then
+            if (is /= n) then
+              isw = is
+              delew = one
+            else if (iw /= n) then
+              isw = iw
+              ise = ie
+              if (ie == n) delew = one
+              delns = one
+            else
+              isw = n
+              ise = ie
+              delew = one
+              delns = one
+            endif
+          endif
+  
+          grad1_lon_zero(n) = delew*(grid1_array(ise) - grid1_array(isw))
+          grad1_latlon(n) = delns*(grad1_lat_zero(n) - grad1_lon_zero(n))
+!         if (n.ge.8000) write(6,*) 4,grad1_lon_zero(n),grad1_latlon(n)
+  
+        endif
+      enddo
+  
+      write(6,*) 'remapping'
+      call remap(grid2_array, wts_map1, grid2_add_map1, grid1_add_map1, &
+                 grid1_array, src_grad1=grad1_lat,                    &
+                 src_grad2=grad1_lon, src_grad3=grad1_latlon)
+  
+      print *,'Third order mapping from grid1 to grid2:'
+      print *,'----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_array  ),maxval(grid2_array  )
+    
+      ! -  Conservation Test
+    
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_array  *grid2_area*grid2_frac)
+    
+    !-----------------------------------------------------------------------
+    ! - a first-order map from grid1 to grid2
+  
+    else if (map_type /= map_type_conserv .AND.map_type /= map_type_bicubic) then
+
+      write(6,*) 'bilinear or conservative'
+  
+      call remap(grid2_array, wts_map1, grid2_add_map1, grid1_add_map1,grid1_array)
+  
+      print *,'First order mapping from grid1 to grid2:'
+      print *,'----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_array  ),maxval(grid2_array  )
+    
+      ! -  Conservation Test
+    
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_array  *grid2_area*grid2_frac)
+    
+    !-----------------------------------------------------------------------
+    ! - conservative mappings:
+    ! - a second-order map from grid1 to grid2 with only lat grads
+  
+    else if (map_type == map_type_conserv .AND. lat_gradient) then
+  
+      call remap(grid2_array, wts_map1, grid2_add_map1, grid1_add_map1,  &
+                 grid1_array, src_grad1=grad1_lat,src_grad2=grad1_lon_zero) 
+  
+      select case (norm_opt)
+      case (norm_opt_none)
+        grid2_tmp2 = grid2_frac*grid2_area
+        where (grid2_tmp2 /= zero)
+          grid2_array = grid2_array/grid2_tmp2
+        elsewhere
+          grid2_array = zero
+        end where
+      case (norm_opt_frcarea)
+      case (norm_opt_dstarea)
+        where (grid2_frac /= zero)
+          grid2_array = grid2_array/grid2_frac
+        elsewhere
+          grid2_array = zero
+        end where
+      end select
+  
+      print *,'Second order mapping from grid1 to grid2 (lat only):'
+      print *,'----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_array  ),maxval(grid2_array  )
+  
+      ! -  Conservation Test
+  
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_array*grid2_area*grid2_frac)
+  
+    !-----------------------------------------------------------------------
+    ! - conservative mappings:
+    ! - a second-order map from grid1 to grid2 both gradients
+  
+    else if (map_type == map_type_conserv .AND..NOT. lat_gradient) then
+  
+      call remap(grid2_array,wts_map1,grid2_add_map1,grid1_add_map1,  &
+                 grid1_array, src_grad1=grad1_lat,src_grad2=grad1_lon) 
+  
+      select case (norm_opt)
+      case (norm_opt_none)
+        grid2_tmp2 = grid2_frac*grid2_area
+        where (grid2_tmp2 /= zero)
+          grid2_array = grid2_array/grid2_tmp2
+        elsewhere
+          grid2_array = zero
+        end where
+      case (norm_opt_frcarea)
+      case (norm_opt_dstarea)
+        where (grid2_frac /= zero)
+          grid2_array = grid2_array/grid2_frac
+        elsewhere
+          grid2_array = zero
+        end where
+      end select
+  
+      print *,'Second order mapping from grid1 to grid2:'
+      print *,'-----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_array  ),maxval(grid2_array  )
+  
+      ! -  Conservation Test
+  
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_array*grid2_area*grid2_frac)
+  
+    endif
+  
+    !-----------------------------------------------------------------------
+    !     calculate some statistics
+  
+    grid2_count = zero
+    grid2_tmp1  = zero
+    grid2_tmp2  = zero
+  
+    print *,'number of sparse matrix entries ',num_links_map1
+    do n=1,num_links_map1
+      grid2_count(grid2_add_map1(n)) = grid2_count(grid2_add_map1(n)) + 1
+      if (wts_map1(1,n) > one .or. wts_map1(1,n) < zero) then
+        grid2_tmp1(grid2_add_map1(n)) = grid2_tmp1(grid2_add_map1(n)) + 1
+        grid2_tmp2(grid2_add_map1(n)) = max(abs(wts_map1(1,n)),grid2_tmp2(grid2_add_map1(n)) )
+      endif
+    end do
+  
+    do n=1,grid2_size
+      if (grid2_tmp1(n) > zero) print *,n,grid2_tmp2(n)
+    end do
+  
+    imin = minval(grid2_count, mask=(grid2_count > 0))
+    imax = maxval(grid2_count)
+    idiff =  (imax - imin)/10 + 1
+    print *,'total number of dest cells ',grid2_size
+    print *,'number of cells participating in remap ',count(grid2_count > zero)
+    print *,'min no of entries/row = ',imin
+    print *,'max no of entries/row = ',imax
+  
+    imax = imin + idiff
+    do n=1,10
+      print *,'num of rows with entries between ',imin,' - ',imax-1,   &
+               count(grid2_count >= imin .and. grid2_count < imax)
+      imin = imin + idiff
+      imax = imax + idiff
+    end do
+  
+    !-----------------------------------------------------------------------
+    ! - deallocate arrays
+  
+    deallocate (grid1_tmp, grad1_lat, grad1_lon,    &
+                grad1_lat_zero, grad1_lon_zero, grid1_imask,     &
+                grid2_tmp1, grid2_tmp2,   &
+                grid2_imask, grid2_count)
+  
+  end subroutine calculate_grid
+
+  ! ==========================================================================
+
+end module scripinterp_mod
+
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripshape.F90
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripshape.F90	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripshape.F90	(revision 2352)
@@ -0,0 +1,419 @@
+      PROGRAM scripshape
+!
+! program to take output from the SCRIP weights generator
+! and rearrange the data into a series of 2D fields suitable
+! for reading with iom_get in NEMO configurations using the
+! interpolation on the fly option
+!
+      USE netcdf
+      IMPLICIT none
+      INTEGER    :: ncId, VarId, status
+      INTEGER    :: start(4), count(4)
+      CHARACTER(LEN=1) :: y
+      INTEGER    :: nd, ns, nl, nw, sx, sy, dx, dy
+      INTEGER    :: i, j, k, m, n, smax
+!
+!  ifort -O2 -o scripshape scripshape.f90 \
+!        -I/nerc/packages/netcdfifort/v3.6.0-pl1/include \
+!        -L/nerc/packages/netcdfifort/v3.6.0-pl1/lib -lnetcdf
+!
+!
+      INTEGER(KIND=4), ALLOCATABLE :: src(:)
+      INTEGER(KIND=4), ALLOCATABLE :: dst(:)
+      REAL(KIND=8), ALLOCATABLE :: wgt(:,:)
+      REAL(KIND=8), ALLOCATABLE :: src1(:,:),dst1(:,:),wgt1(:,:)
+      LOGICAL  :: around, verbose
+#if defined ARGC
+      INTEGER(KIND=4) :: iargc
+      EXTERNAL :: iargc
+#endif
+
+      CHARACTER(LEN=256) :: interp_file, output_file, name_file
+      INTEGER            :: ew_wrap
+      NAMELIST /shape_inputs/ interp_file, output_file, ew_wrap
+
+! scripshape requires 1 arguments; the name of the file containing
+! the input namelist.
+! This namelist contains:
+!     the name of the input file containing the weights ! produced by SCRIP in its format;
+!     the name of the new output file which ! is to contain the reorganized fields ready for input to NEMO.
+!     the east-west wrapping of the input grid (-1, 0, 1 and 2 are accepted values)
+!
+! E.g.
+!     interp_file = 'data_nemo_bilin.nc'
+!     output_file = 'weights_bilin.nc'
+!     ew_wrap     = 2
+!
+#if defined ARGC
+      IF (iargc() == 1) THEN
+        CALL getarg(1, name_file)
+      ELSE
+        WRITE(*,*) 'Usage: scripshape namelist_file'
+        STOP
+      ENDIF
+#else
+      WRITE(6,*) 'enter name of namelist file'
+      READ(5,*) name_file
+#endif
+      interp_file = 'none'
+      output_file = 'none'
+      ew_wrap = 0
+      OPEN(12, FILE=name_file, STATUS='OLD', FORM='FORMATTED')
+      READ(12, NML=shape_inputs)
+      CLOSE(12)
+!
+      INQUIRE(FILE = TRIM(interp_file), EXIST=around)
+      IF (.not.around) THEN
+       WRITE(*,*) 'Input file: '//TRIM(interp_file)//' not found'
+       STOP
+      ENDIF
+! 
+      INQUIRE(FILE = TRIM(output_file), EXIST=around)
+      IF (around) THEN
+       WRITE(*,*) 'Output file: '//TRIM(output_file)//' exists'
+       WRITE(*,*) 'Ok to overwrite (y/n)?'
+       READ(5,'(a)') y
+       IF ( y .ne. 'y' .AND. y .ne. 'Y' ) STOP
+      ENDIF
+!
+      verbose = .true.
+!
+! Obtain grid size information from interp_file
+!
+      CALL ncgetsize
+!
+! Allocate array spaces
+!
+      ALLOCATE(src(nl), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('src')
+      ALLOCATE(dst(nl), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('dst')
+      ALLOCATE(wgt(nw,nl), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('wgt')
+      ALLOCATE(src1(dx,dy), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('src1')
+      ALLOCATE(dst1(dx,dy), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('dst1')
+      ALLOCATE(wgt1(dx,dy), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('wgt1')
+!
+! Read all required data from interp_file
+!
+      CALL ncgetfields
+!
+! Check that dst is monotonically increasing
+!
+      DO k = 1,nl-1
+       IF(dst(k+1).lt.dst(k)) THEN
+        WRITE(*,*) 'non-monotonic at ',k
+        WRITE(*,*) dst(k-4:k+16)
+        STOP
+       ENDIF
+      END DO
+!
+! Remove references to the top row of src
+!
+      IF(verbose) WRITE(*,*) &
+        'Removing references to the top row of the source grid'
+      smax = (sy-1)*sx
+      n = 0
+      DO k = 1,nl
+       IF(src(k).gt.smax-1) THEN
+        src(k) = src(k)-sx
+        n = n + 1
+       ENDIF
+      END DO
+      IF(verbose) WRITE(*,*) n,' values changed (',100.*n/nl,'%)'
+!
+! Loop through weights for each corner in turn and
+! rearrange weight fields into separate 2D fields for
+! reading with iom_get in NEMO
+!
+      DO k = 1,nw
+       DO n = 1,4
+
+        i = 0
+        j = 1
+        DO m = n,nl,4
+         i = i+1
+         IF(i.gt.dx) THEN
+          i = 1
+          j = j + 1
+         ENDIF
+         src1(i,j) = src(m)
+         dst1(i,j) = dst(m)
+         wgt1(i,j) = wgt(k,m)
+        END DO
+!
+! Write out this set which will be labelled with
+! a 2 digit number equal to n+4*(k-1)
+!
+        CALL wrwgts
+!   
+       END DO
+      END DO
+      STOP
+      CONTAINS
+!
+!----------------------------------------------------------------------*
+      SUBROUTINE ncgetsize
+!
+! Access grid size information in interp_file and set the
+! following integers:
+!
+!    nd = dst_grid_size
+!    ns = src_grid_size
+!    nl = num_links    
+!    nw = num_wgts     
+! sx,sy = src_grid_dims     
+! dx,dy = dst_grid_dims     
+!
+      INTEGER idims(2)
+!
+       status = nf90_open(interp_file, nf90_NoWrite, ncid)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_dimid(ncid, 'dst_grid_size', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_inquire_dimension(ncid, VarId, LEN = nd)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_dimid(ncid, 'src_grid_size', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_inquire_dimension(ncid, VarId, LEN = ns)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_dimid(ncid, 'num_links', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_inquire_dimension(ncid, VarId, LEN = nl)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_dimid(ncid, 'num_wgts', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_inquire_dimension(ncid, VarId, LEN = nw)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       start = 1
+       count = 2
+       status = nf90_inq_varid(ncid, 'src_grid_dims', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_get_var(ncid, VarId, idims, start, count)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       sx = idims(1) ; sy = idims(2)
+!
+       status = nf90_inq_varid(ncid, 'dst_grid_dims', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_get_var(ncid, VarId, idims, start, count)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       dx = idims(1) ; dy = idims(2)
+!
+       status = nf90_close(ncid)
+       IF (status /= nf90_noerr) CALL handle_err(status)
+!
+       IF(verbose) THEN
+         WRITE(*,*) 'Detected sizes: '
+         WRITE(*,*) 'dst_grid_size: ', nd
+         WRITE(*,*) 'src_grid_size: ', ns
+         WRITE(*,*) 'num_links    : ', nl
+         WRITE(*,*) 'num_wgts     : ', nw
+         WRITE(*,*) 'src_grid_dims: ', sx, ' x ', sy
+         WRITE(*,*) 'dst_grid_dims: ', dx, ' x ', dy
+       ENDIF
+!
+      END SUBROUTINE ncgetsize
+
+!----------------------------------------------------------------------*
+      SUBROUTINE ncgetfields
+!
+! Read all required data from interp_file. The data read are:
+!
+! netcdf variable    size   internal array
+!-----------------+-------+--------------
+! src_address        nl     src
+! dst_address        nl     dst
+! remap_matrix     (nw,nl)  wgt
+!
+       status = nf90_open(interp_file, nf90_NoWrite, ncid)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_varid(ncid, 'src_address', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! Read the values for src
+       status = nf90_get_var(ncid, VarId, src, &
+                         start = (/ 1 /),      &
+                         count = (/ nl /))
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_varid(ncid, 'dst_address', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! Read the values for dst
+       status = nf90_get_var(ncid, VarId, dst, &
+                         start = (/ 1 /),      &
+                         count = (/ nl /))
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_varid(ncid, 'remap_matrix', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! Read the values for wgt
+       status = nf90_get_var(ncid, VarId, wgt, &
+                         start = (/ 1, 1 /),   &
+                         count = (/ nw, nl /))
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_close(ncid)
+       IF (status /= nf90_noerr) CALL handle_err(status)
+!
+      END SUBROUTINE ncgetfields
+
+!----------------------------------------------------------------------*
+      SUBROUTINE handle_err(status)
+!
+! Simple netcdf error checking routine
+!
+      INTEGER, intent ( in) :: status
+!
+      IF(status /= nf90_noerr) THEN
+       IF(trim(nf90_strerror(status)) .eq. 'Attribute not found') THEN
+! ignore
+       ELSE
+        WRITE(*,*) trim(nf90_strerror(status))
+        STOP "Stopped"
+       END IF
+      END IF
+      END SUBROUTINE handle_err
+
+!----------------------------------------------------------------------*
+      SUBROUTINE alloc_err(arname)
+!
+! Simple allocation error checking routine
+!
+      CHARACTER(LEN=*) :: arname
+!
+      WRITE(*,*) 'Allocation error attempting to ALLOCATE '//arname
+      STOP "Stopped"
+      END SUBROUTINE alloc_err
+
+!                                                                       
+!----------------------------------------------------------------------*
+      SUBROUTINE wrwgts
+!
+! Write out each set of 2D fields to output_file.
+! Each call will write out a set of srcXX, dstXX and wgtXX fields
+! where XX is a two digit number equal to n + 4*(k-1). The first
+! and last calls to this routine initialise and close the output
+! file respectively. The first call is detected when k*n=1 and the
+! last call is detected when k*n=4*nw. The outfile file remains
+! open between the first and last calls. 
+!
+      INTEGER :: status, ncid, ncin
+      INTEGER :: Lontdid, Lattdid
+      INTEGER :: tvid, tvid2, tvid3
+      INTEGER :: ioldfill
+      CHARACTER(LEN=2) :: cs
+      SAVE ncid
+!
+      IF(k*n.eq.1) THEN
+!
+! Create output_file and set the dimensions
+!
+         status = nf90_create(output_file, nf90_Clobber, ncid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+         status = nf90_set_fill(ncid, nf90_NoFill, ioldfill)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_def_dim(ncid, "lon", dx, Lontdid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+         status = nf90_def_dim(ncid, "lat", dy, Lattdid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_put_att(ncid, nf90_global, 'ew_wrap', ew_wrap)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+      ELSE
+!
+! Reenter define mode
+!
+         status = nf90_redef(ncid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+      ENDIF
+!
+      WRITE(cs,'(i2.2)') n + 4*(k-1)
+!
+! Define new variables
+!
+      status = nf90_def_var(ncid, "src"//cs, nf90_double, &
+                         (/ Lontdid, Lattdid /), tvid)
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+      status = nf90_def_var(ncid, "dst"//cs, nf90_double, &
+                         (/ Lontdid, Lattdid /), tvid2)
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+      status = nf90_def_var(ncid, "wgt"//cs, nf90_double, &
+                         (/ Lontdid, Lattdid /), tvid3)
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! Leave define mode
+!
+      status = nf90_enddef(ncid)
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! Write the data
+!
+      status = nf90_put_var(ncid, tvid, src1,    &
+                            start = (/ 1, 1 /),  &
+                            count = (/ dx, dy /) )
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+      status = nf90_put_var(ncid, tvid2, dst1,   &
+                            start = (/ 1, 1 /),  &
+                            count = (/ dx, dy /) )
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+      status = nf90_put_var(ncid, tvid3, wgt1,   &
+                            start = (/ 1, 1  /), &
+                            count = (/ dx, dy /) )
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+      IF(k*n.eq.4*nw) THEN
+!
+! --     Reenter define mode
+!
+         status = nf90_redef(ncid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! --     Reopen interp_file and transfer some global attributes
+!
+         status = nf90_open(interp_file, nf90_NoWrite, ncin)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_copy_att(ncin,NF90_GLOBAL,'title',        ncid,NF90_GLOBAL)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_copy_att(ncin,NF90_GLOBAL,'normalization',ncid,NF90_GLOBAL)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_copy_att(ncin,NF90_GLOBAL,'map_method',   ncid,NF90_GLOBAL)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_copy_att(ncin,NF90_GLOBAL,'conventions',  ncid,NF90_GLOBAL)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_copy_att(ncin,NF90_GLOBAL,'history',      ncid,NF90_GLOBAL)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! --     Close interp_file
+!
+         status = nf90_close(ncin)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! --     Close output_file
+!
+         status = nf90_close(ncid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+      ENDIF
+
+      END SUBROUTINE wrwgts
+      END PROGRAM scripshape
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/CHANGES_BY_NOCS
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/CHANGES_BY_NOCS	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/CHANGES_BY_NOCS	(revision 2352)
@@ -0,0 +1,12 @@
+
+      SCRIP code, version 1.4, from Los Alamos National Laboratory (http://climate.lanl.gov/Software/SCRIP)
+
+      Changes made at NOCS for inclusion of weights generation code in NEMO 3.3 and later:
+
+          - File extensions changed from '.f' to '.f90'
+          - File netcdf.f renamed as netcdf_mod.f90 to avoid clash with netcdf library module filename
+          - File netcdf.f modified to add error message to netcdf_error_handler
+          - Small bug in remap_conserv when using gfortran compiler: replace ". and." with " .and."
+          - continuation lines reformatted with '&' moved from the start of the continuation line to 
+            the end of the line before
+    
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/constants.f90
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/constants.f90	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/constants.f90	(revision 2352)
@@ -0,0 +1,65 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module defines common constants used in many routines.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: constants.f,v 1.2 2000/04/19 21:56:25 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module constants
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod  ! defines common data types
+
+      implicit none
+
+      save
+
+!-----------------------------------------------------------------------
+
+      real (kind = dbl_kind), parameter ::  &
+                              zero   = 0.0_dbl_kind, &
+                              one    = 1.0_dbl_kind, &
+                              two    = 2.0_dbl_kind, &
+                              three  = 3.0_dbl_kind, &
+                              four   = 4.0_dbl_kind, &
+                              five   = 5.0_dbl_kind, &
+                              half   = 0.5_dbl_kind, &
+                              quart  = 0.25_dbl_kind, &
+                              bignum = 1.e+20_dbl_kind, &
+                              tiny   = 1.e-14_dbl_kind, &
+                              pi     = 3.14159265359_dbl_kind, &
+                              pi2    = two*pi, &
+                              pih    = half*pi
+
+!-----------------------------------------------------------------------
+
+      end module constants
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/copyright
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/copyright	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/copyright	(revision 2352)
@@ -0,0 +1,26 @@
+!-----------------------------------------------------------------------
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!-----------------------------------------------------------------------
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/grids.f90
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/grids.f90	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/grids.f90	(revision 2352)
@@ -0,0 +1,831 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module reads in and initializes two grids for remapping.
+!     NOTE: grid1 must be the master grid -- the grid that determines
+!           which cells participate (e.g. land mask) and the fractional
+!           area of grid2 cells that participate in the remapping.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: grids.f,v 1.6 2001/08/21 21:06:41 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module grids
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod    ! defines data types
+      use constants    ! common constants
+      use iounits      ! I/O unit manager
+      use netcdf_mod   ! netCDF stuff
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     variables that describe each grid
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), save :: &
+                   grid1_size, grid2_size,  & ! total points on each grid
+                   grid1_rank, grid2_rank,  & ! rank of each grid
+                   grid1_corners, grid2_corners ! number of corners
+                                                ! for each grid cell
+
+      integer (kind=int_kind), dimension(:), allocatable, save :: &
+                   grid1_dims, grid2_dims  ! size of each grid dimension
+
+      character(char_len), save ::  &
+                   grid1_name, grid2_name  ! name for each grid
+
+      character (char_len), save ::  &
+                   grid1_units,  & ! units for grid coords (degs/radians)
+                   grid2_units  ! units for grid coords
+
+      real (kind=dbl_kind), parameter :: &
+            deg2rad = pi/180.   ! conversion for deg to rads
+
+!-----------------------------------------------------------------------
+!
+!     grid coordinates and masks
+!
+!-----------------------------------------------------------------------
+
+      logical (kind=log_kind), dimension(:), allocatable, save :: &
+                   grid1_mask,         & ! flag which cells participate
+                   grid2_mask         ! flag which cells participate
+
+      real (kind=dbl_kind), dimension(:), allocatable, save :: &
+                   grid1_center_lat,   & ! lat/lon coordinates for
+                   grid1_center_lon,   & ! each grid center in radians
+                   grid2_center_lat,  &
+                   grid2_center_lon, &
+                   grid1_area,         & ! tot area of each grid1 cell
+                   grid2_area,         & ! tot area of each grid2 cell
+                   grid1_area_in,      & ! area of grid1 cell from file
+                   grid2_area_in,      & ! area of grid2 cell from file
+                   grid1_frac,         & ! fractional area of grid cells
+                   grid2_frac         ! participating in remapping
+
+      real (kind=dbl_kind), dimension(:,:), allocatable, save :: &
+                   grid1_corner_lat,   & ! lat/lon coordinates for
+                   grid1_corner_lon,   & ! each grid corner in radians
+                   grid2_corner_lat,  &
+                   grid2_corner_lon
+
+      logical (kind=log_kind), save :: &
+                   luse_grid_centers  & ! use centers for bounding boxes
+      ,            luse_grid1_area    & ! use area from grid file
+      ,            luse_grid2_area   ! use area from grid file
+
+      real (kind=dbl_kind), dimension(:,:), allocatable, save :: &
+                   grid1_bound_box,   & ! lat/lon bounding box for use
+                   grid2_bound_box   ! in restricting grid searches
+
+!-----------------------------------------------------------------------
+!
+!     bins for restricting searches
+!
+!-----------------------------------------------------------------------
+
+      character (char_len), save :: &
+              restrict_type  ! type of bins to use
+
+      integer (kind=int_kind), save :: &
+              num_srch_bins  ! num of bins for restricted srch
+
+      integer (kind=int_kind), dimension(:,:), allocatable, save :: &
+              bin_addr1,  & ! min,max adds for grid1 cells in this lat bin
+              bin_addr2  ! min,max adds for grid2 cells in this lat bin
+
+      real(kind=dbl_kind), dimension(:,:), allocatable, save :: &
+              bin_lats    & ! min,max latitude for each search bin
+      ,       bin_lons   ! min,max longitude for each search bin
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine grid_init(grid1_file, grid2_file)
+
+!-----------------------------------------------------------------------
+!
+!     this routine reads grid info from grid files and makes any
+!     necessary changes (e.g. for 0,2pi longitude range)
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(in) ::  &
+                   grid1_file, grid2_file  ! grid data files
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) ::  &
+        n       & ! loop counter
+      , nele    & ! element loop counter
+      , iunit   & ! unit number for opening files
+      , i,j     & ! logical 2d addresses
+      , ip1,jp1 &
+      , n_add, e_add, ne_add &
+      , nx, ny
+
+      integer (kind=int_kind) ::  &
+               ncstat,            & ! netCDF status variable
+               nc_grid1_id,        & ! netCDF grid file id
+               nc_grid2_id,        & ! netCDF grid file id
+               nc_grid1size_id,    & ! netCDF grid size dim id
+               nc_grid2size_id,    & ! netCDF grid size dim id
+               nc_grid1corn_id,    & ! netCDF grid corner dim id
+               nc_grid2corn_id,    & ! netCDF grid corner dim id
+               nc_grid1rank_id,    & ! netCDF grid rank dim id
+               nc_grid2rank_id,    & ! netCDF grid rank dim id
+               nc_grid1area_id,    & ! netCDF grid rank dim id
+               nc_grid2area_id,    & ! netCDF grid rank dim id
+               nc_grid1dims_id,    & ! netCDF grid dimension size id
+               nc_grid2dims_id,    & ! netCDF grid dimension size id
+               nc_grd1imask_id,    & ! netCDF grid imask var id
+               nc_grd2imask_id,    & ! netCDF grid imask var id
+               nc_grd1crnrlat_id,  & ! netCDF grid corner lat var id
+               nc_grd2crnrlat_id,  & ! netCDF grid corner lat var id
+               nc_grd1crnrlon_id,  & ! netCDF grid corner lon var id
+               nc_grd2crnrlon_id,  & ! netCDF grid corner lon var id
+               nc_grd1cntrlat_id,  & ! netCDF grid center lat var id
+               nc_grd2cntrlat_id,  & ! netCDF grid center lat var id
+               nc_grd1cntrlon_id,  & ! netCDF grid center lon var id
+               nc_grd2cntrlon_id  ! netCDF grid center lon var id
+
+      integer (kind=int_kind), dimension(:), allocatable ::  &
+                                  imask ! integer mask read from file
+
+      real (kind=dbl_kind) ::  &
+        dlat,dlon           ! lat/lon intervals for search bins
+
+      real (kind=dbl_kind), dimension(4) :: &
+        tmp_lats, tmp_lons  ! temps for computing bounding boxes
+
+!-----------------------------------------------------------------------
+!
+!     open grid files and read grid size/name data
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_open(grid1_file, NF_NOWRITE, nc_grid1_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_open(grid2_file, NF_NOWRITE, nc_grid2_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid1_id, 'grid_size', nc_grid1size_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid1_id, nc_grid1size_id, grid1_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid2_id, 'grid_size', nc_grid2size_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid2_id, nc_grid2size_id, grid2_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid1_id, 'grid_rank', nc_grid1rank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid1_id, nc_grid1rank_id, grid1_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid2_id, 'grid_rank', nc_grid2rank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid2_id, nc_grid2rank_id, grid2_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid1_id,'grid_corners',nc_grid1corn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid1_id,nc_grid1corn_id,grid1_corners)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid2_id,'grid_corners',nc_grid2corn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid2_id,nc_grid2corn_id,grid2_corners)
+      call netcdf_error_handler(ncstat)
+
+      allocate( grid1_dims(grid1_rank), &
+                grid2_dims(grid2_rank))
+
+      ncstat = nf_get_att_text(nc_grid1_id, nf_global, 'title', &
+                               grid1_name)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text(nc_grid2_id, nf_global, 'title', &
+                               grid2_name)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     allocate grid coordinates/masks and read data
+!
+!-----------------------------------------------------------------------
+
+      allocate( grid1_mask      (grid1_size), &
+                grid2_mask      (grid2_size), &
+                grid1_center_lat(grid1_size),  &
+                grid1_center_lon(grid1_size), &
+                grid2_center_lat(grid2_size),  &
+                grid2_center_lon(grid2_size), &
+                grid1_area      (grid1_size), &
+                grid2_area      (grid2_size), &
+                grid1_frac      (grid1_size), &
+                grid2_frac      (grid2_size), &
+                grid1_corner_lat(grid1_corners, grid1_size), &
+                grid1_corner_lon(grid1_corners, grid1_size), &
+                grid2_corner_lat(grid2_corners, grid2_size), &
+                grid2_corner_lon(grid2_corners, grid2_size), &
+                grid1_bound_box (4            , grid1_size), &
+                grid2_bound_box (4            , grid2_size))
+
+      allocate(imask(grid1_size))
+
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_dims', nc_grid1dims_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_imask', nc_grd1imask_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_center_lat',  &
+                                         nc_grd1cntrlat_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_center_lon',  &
+                                         nc_grd1cntrlon_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_corner_lat',  &
+                                         nc_grd1crnrlat_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_corner_lon',  &
+                                         nc_grd1crnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_grid1_id, nc_grid1dims_id, grid1_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_grid1_id, nc_grd1imask_id, imask)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid1_id, nc_grd1cntrlat_id,  &
+                                             grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid1_id, nc_grd1cntrlon_id,  &
+                                             grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid1_id, nc_grd1crnrlat_id,  &
+                                             grid1_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid1_id, nc_grd1crnrlon_id,  &
+                                             grid1_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (luse_grid1_area) then
+        allocate (grid1_area_in(grid1_size))
+        ncstat = nf_inq_varid(nc_grid1_id, 'grid_area', nc_grid1area_id)
+        call netcdf_error_handler(ncstat)
+        ncstat = nf_get_var_double(nc_grid1_id, nc_grid1area_id,  &
+                                                grid1_area_in)
+        call netcdf_error_handler(ncstat)
+      endif
+
+      grid1_area = zero
+      grid1_frac = zero
+
+!-----------------------------------------------------------------------
+!
+!     initialize logical mask and convert lat/lon units if required
+!
+!-----------------------------------------------------------------------
+
+      where (imask == 1)
+        grid1_mask = .true.
+      elsewhere
+        grid1_mask = .false.
+      endwhere
+      deallocate(imask)
+
+      grid1_units = ' '
+      ncstat = nf_get_att_text(nc_grid1_id, nc_grd1cntrlat_id, 'units', &
+                               grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+
+        grid1_center_lat = grid1_center_lat*deg2rad
+        grid1_center_lon = grid1_center_lon*deg2rad
+
+      case ('radians')
+
+        !*** no conversion necessary
+
+      case default
+
+        print *,'unknown units supplied for grid1 center lat/lon: '
+        print *,'proceeding assuming radians'
+
+      end select
+
+      grid1_units = ' '
+      ncstat = nf_get_att_text(nc_grid1_id, nc_grd1crnrlat_id, 'units', &
+                               grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+
+        grid1_corner_lat = grid1_corner_lat*deg2rad
+        grid1_corner_lon = grid1_corner_lon*deg2rad
+
+      case ('radians')
+
+        !*** no conversion necessary
+
+      case default
+
+        print *,'unknown units supplied for grid1 corner lat/lon: '
+        print *,'proceeding assuming radians'
+
+      end select
+
+      ncstat = nf_close(nc_grid1_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     read data for grid 2
+!
+!-----------------------------------------------------------------------
+
+      allocate(imask(grid2_size))
+
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_dims', nc_grid2dims_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_imask', nc_grd2imask_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_center_lat',  &
+                                         nc_grd2cntrlat_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_center_lon',  &
+                                         nc_grd2cntrlon_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_corner_lat',  &
+                                         nc_grd2crnrlat_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_corner_lon',  &
+                                         nc_grd2crnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_grid2_id, nc_grid2dims_id, grid2_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_grid2_id, nc_grd2imask_id, imask)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid2_id, nc_grd2cntrlat_id,  &
+                                             grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid2_id, nc_grd2cntrlon_id,  &
+                                             grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid2_id, nc_grd2crnrlat_id,  &
+                                             grid2_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid2_id, nc_grd2crnrlon_id,  &
+                                             grid2_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (luse_grid2_area) then
+        allocate (grid2_area_in(grid2_size))
+        ncstat = nf_inq_varid(nc_grid2_id, 'grid_area', nc_grid2area_id)
+        call netcdf_error_handler(ncstat)
+        ncstat = nf_get_var_double(nc_grid2_id, nc_grid2area_id,  &
+                                                grid2_area_in)
+        call netcdf_error_handler(ncstat)
+      endif
+
+      grid2_area = zero
+      grid2_frac = zero
+
+!-----------------------------------------------------------------------
+!
+!     initialize logical mask and convert lat/lon units if required
+!
+!-----------------------------------------------------------------------
+
+      where (imask == 1)
+        grid2_mask = .true.
+      elsewhere
+        grid2_mask = .false.
+      endwhere
+      deallocate(imask)
+
+      grid2_units = ' '
+      ncstat = nf_get_att_text(nc_grid2_id, nc_grd2cntrlat_id, 'units', &
+                               grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+
+        grid2_center_lat = grid2_center_lat*deg2rad
+        grid2_center_lon = grid2_center_lon*deg2rad
+
+      case ('radians')
+
+        !*** no conversion necessary
+
+      case default
+
+        print *,'unknown units supplied for grid2 center lat/lon: '
+        print *,'proceeding assuming radians'
+
+      end select
+
+      grid2_units = ' '
+      ncstat = nf_get_att_text(nc_grid2_id, nc_grd2crnrlat_id, 'units', &
+                               grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+
+        grid2_corner_lat = grid2_corner_lat*deg2rad
+        grid2_corner_lon = grid2_corner_lon*deg2rad
+
+      case ('radians')
+
+        !*** no conversion necessary
+
+      case default
+
+        print *,'no units supplied for grid2 corner lat/lon: '
+        print *,'proceeding assuming radians'
+
+      end select
+
+      ncstat = nf_close(nc_grid2_id)
+      call netcdf_error_handler(ncstat)
+
+
+!-----------------------------------------------------------------------
+!
+!     convert longitudes to 0,2pi interval
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_center_lon .gt. pi2)  grid1_center_lon = &
+                                         grid1_center_lon - pi2
+      where (grid1_center_lon .lt. zero) grid1_center_lon = &
+                                         grid1_center_lon + pi2
+      where (grid2_center_lon .gt. pi2)  grid2_center_lon = &
+                                         grid2_center_lon - pi2
+      where (grid2_center_lon .lt. zero) grid2_center_lon = &
+                                         grid2_center_lon + pi2
+      where (grid1_corner_lon .gt. pi2)  grid1_corner_lon = &
+                                         grid1_corner_lon - pi2
+      where (grid1_corner_lon .lt. zero) grid1_corner_lon = &
+                                         grid1_corner_lon + pi2
+      where (grid2_corner_lon .gt. pi2)  grid2_corner_lon = &
+                                         grid2_corner_lon - pi2
+      where (grid2_corner_lon .lt. zero) grid2_corner_lon = &
+                                         grid2_corner_lon + pi2
+
+!-----------------------------------------------------------------------
+!
+!     make sure input latitude range is within the machine values
+!     for +/- pi/2 
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_center_lat >  pih) grid1_center_lat =  pih
+      where (grid1_corner_lat >  pih) grid1_corner_lat =  pih
+      where (grid1_center_lat < -pih) grid1_center_lat = -pih
+      where (grid1_corner_lat < -pih) grid1_corner_lat = -pih
+
+      where (grid2_center_lat >  pih) grid2_center_lat =  pih
+      where (grid2_corner_lat >  pih) grid2_corner_lat =  pih
+      where (grid2_center_lat < -pih) grid2_center_lat = -pih
+      where (grid2_corner_lat < -pih) grid2_corner_lat = -pih
+
+!-----------------------------------------------------------------------
+!
+!     compute bounding boxes for restricting future grid searches
+!
+!-----------------------------------------------------------------------
+
+      if (.not. luse_grid_centers) then
+        grid1_bound_box(1,:) = minval(grid1_corner_lat, DIM=1)
+        grid1_bound_box(2,:) = maxval(grid1_corner_lat, DIM=1)
+        grid1_bound_box(3,:) = minval(grid1_corner_lon, DIM=1)
+        grid1_bound_box(4,:) = maxval(grid1_corner_lon, DIM=1)
+
+        grid2_bound_box(1,:) = minval(grid2_corner_lat, DIM=1)
+        grid2_bound_box(2,:) = maxval(grid2_corner_lat, DIM=1)
+        grid2_bound_box(3,:) = minval(grid2_corner_lon, DIM=1)
+        grid2_bound_box(4,:) = maxval(grid2_corner_lon, DIM=1)
+
+      else
+
+        nx = grid1_dims(1)
+        ny = grid1_dims(2)
+
+        do n=1,grid1_size
+
+          !*** find N,S and NE points to this grid point
+
+          j = (n - 1)/nx +1
+          i = n - (j-1)*nx
+
+          if (i < nx) then
+            ip1 = i + 1
+          else
+            !*** assume cyclic
+            ip1 = 1
+            !*** but if it is not, correct
+            e_add = (j - 1)*nx + ip1
+            if (abs(grid1_center_lat(e_add) -  &
+                    grid1_center_lat(n   )) > pih) then
+              ip1 = i
+            endif
+          endif
+
+          if (j < ny) then
+            jp1 = j+1
+          else
+            !*** assume cyclic
+            jp1 = 1
+            !*** but if it is not, correct
+            n_add = (jp1 - 1)*nx + i
+            if (abs(grid1_center_lat(n_add) -  &
+                    grid1_center_lat(n   )) > pih) then
+              jp1 = j
+            endif
+          endif
+
+          n_add = (jp1 - 1)*nx + i
+          e_add = (j - 1)*nx + ip1
+          ne_add = (jp1 - 1)*nx + ip1
+
+          !*** find N,S and NE lat/lon coords and check bounding box
+
+          tmp_lats(1) = grid1_center_lat(n)
+          tmp_lats(2) = grid1_center_lat(e_add)
+          tmp_lats(3) = grid1_center_lat(ne_add)
+          tmp_lats(4) = grid1_center_lat(n_add)
+
+          tmp_lons(1) = grid1_center_lon(n)
+          tmp_lons(2) = grid1_center_lon(e_add)
+          tmp_lons(3) = grid1_center_lon(ne_add)
+          tmp_lons(4) = grid1_center_lon(n_add)
+
+          grid1_bound_box(1,n) = minval(tmp_lats)
+          grid1_bound_box(2,n) = maxval(tmp_lats)
+          grid1_bound_box(3,n) = minval(tmp_lons)
+          grid1_bound_box(4,n) = maxval(tmp_lons)
+        end do
+
+        nx = grid2_dims(1)
+        ny = grid2_dims(2)
+
+        do n=1,grid2_size
+
+          !*** find N,S and NE points to this grid point
+
+          j = (n - 1)/nx +1
+          i = n - (j-1)*nx
+
+          if (i < nx) then
+            ip1 = i + 1
+          else
+            !*** assume cyclic
+            ip1 = 1
+            !*** but if it is not, correct
+            e_add = (j - 1)*nx + ip1
+            if (abs(grid2_center_lat(e_add) -  &
+                    grid2_center_lat(n   )) > pih) then
+              ip1 = i
+            endif
+          endif
+
+          if (j < ny) then
+            jp1 = j+1
+          else
+            !*** assume cyclic
+            jp1 = 1
+            !*** but if it is not, correct
+            n_add = (jp1 - 1)*nx + i
+            if (abs(grid2_center_lat(n_add) -  &
+                    grid2_center_lat(n   )) > pih) then
+              jp1 = j
+            endif
+          endif
+
+          n_add = (jp1 - 1)*nx + i
+          e_add = (j - 1)*nx + ip1
+          ne_add = (jp1 - 1)*nx + ip1
+
+          !*** find N,S and NE lat/lon coords and check bounding box
+
+          tmp_lats(1) = grid2_center_lat(n)
+          tmp_lats(2) = grid2_center_lat(e_add)
+          tmp_lats(3) = grid2_center_lat(ne_add)
+          tmp_lats(4) = grid2_center_lat(n_add)
+
+          tmp_lons(1) = grid2_center_lon(n)
+          tmp_lons(2) = grid2_center_lon(e_add)
+          tmp_lons(3) = grid2_center_lon(ne_add)
+          tmp_lons(4) = grid2_center_lon(n_add)
+
+          grid2_bound_box(1,n) = minval(tmp_lats)
+          grid2_bound_box(2,n) = maxval(tmp_lats)
+          grid2_bound_box(3,n) = minval(tmp_lons)
+          grid2_bound_box(4,n) = maxval(tmp_lons)
+        end do
+
+      endif
+
+      where (abs(grid1_bound_box(4,:) - grid1_bound_box(3,:)) > pi)
+        grid1_bound_box(3,:) = zero
+        grid1_bound_box(4,:) = pi2
+      end where
+
+      where (abs(grid2_bound_box(4,:) - grid2_bound_box(3,:)) > pi)
+        grid2_bound_box(3,:) = zero
+        grid2_bound_box(4,:) = pi2
+      end where
+
+      !***
+      !*** try to check for cells that overlap poles
+      !***
+
+      where (grid1_center_lat > grid1_bound_box(2,:)) &
+        grid1_bound_box(2,:) = pih
+
+      where (grid1_center_lat < grid1_bound_box(1,:)) &
+        grid1_bound_box(1,:) = -pih
+
+      where (grid2_center_lat > grid2_bound_box(2,:)) &
+        grid2_bound_box(2,:) = pih
+
+      where (grid2_center_lat < grid2_bound_box(1,:)) &
+        grid2_bound_box(1,:) = -pih
+
+!-----------------------------------------------------------------------
+!
+!     set up and assign address ranges to search bins in order to 
+!     further restrict later searches
+!
+!-----------------------------------------------------------------------
+
+      select case (restrict_type)
+
+      case ('latitude')
+        write(stdout,*) 'Using latitude bins to restrict search.'
+
+        allocate(bin_addr1(2,num_srch_bins))
+        allocate(bin_addr2(2,num_srch_bins))
+        allocate(bin_lats (2,num_srch_bins))
+        allocate(bin_lons (2,num_srch_bins))
+
+        dlat = pi/num_srch_bins
+
+        do n=1,num_srch_bins
+          bin_lats(1,n) = (n-1)*dlat - pih
+          bin_lats(2,n) =     n*dlat - pih
+          bin_lons(1,n) = zero
+          bin_lons(2,n) = pi2
+          bin_addr1(1,n) = grid1_size + 1
+          bin_addr1(2,n) = 0
+          bin_addr2(1,n) = grid2_size + 1
+          bin_addr2(2,n) = 0
+        end do
+
+        do nele=1,grid1_size
+          do n=1,num_srch_bins
+            if (grid1_bound_box(1,nele) <= bin_lats(2,n) .and. &
+                grid1_bound_box(2,nele) >= bin_lats(1,n)) then
+              bin_addr1(1,n) = min(nele,bin_addr1(1,n))
+              bin_addr1(2,n) = max(nele,bin_addr1(2,n))
+            endif
+          end do
+        end do
+
+        do nele=1,grid2_size
+          do n=1,num_srch_bins
+            if (grid2_bound_box(1,nele) <= bin_lats(2,n) .and. &
+                grid2_bound_box(2,nele) >= bin_lats(1,n)) then
+              bin_addr2(1,n) = min(nele,bin_addr2(1,n))
+              bin_addr2(2,n) = max(nele,bin_addr2(2,n))
+            endif
+          end do
+        end do
+
+      case ('latlon')
+        write(stdout,*) 'Using lat/lon boxes to restrict search.'
+
+        dlat = pi /num_srch_bins
+        dlon = pi2/num_srch_bins
+
+        allocate(bin_addr1(2,num_srch_bins*num_srch_bins))
+        allocate(bin_addr2(2,num_srch_bins*num_srch_bins))
+        allocate(bin_lats (2,num_srch_bins*num_srch_bins))
+        allocate(bin_lons (2,num_srch_bins*num_srch_bins))
+
+        n = 0
+        do j=1,num_srch_bins
+        do i=1,num_srch_bins
+          n = n + 1
+
+          bin_lats(1,n) = (j-1)*dlat - pih
+          bin_lats(2,n) =     j*dlat - pih
+          bin_lons(1,n) = (i-1)*dlon
+          bin_lons(2,n) =     i*dlon
+          bin_addr1(1,n) = grid1_size + 1
+          bin_addr1(2,n) = 0
+          bin_addr2(1,n) = grid2_size + 1
+          bin_addr2(2,n) = 0
+        end do
+        end do
+
+        num_srch_bins = num_srch_bins**2
+
+        do nele=1,grid1_size
+          do n=1,num_srch_bins
+            if (grid1_bound_box(1,nele) <= bin_lats(2,n) .and. &
+                grid1_bound_box(2,nele) >= bin_lats(1,n) .and. &
+                grid1_bound_box(3,nele) <= bin_lons(2,n) .and. &
+                grid1_bound_box(4,nele) >= bin_lons(1,n)) then
+              bin_addr1(1,n) = min(nele,bin_addr1(1,n))
+              bin_addr1(2,n) = max(nele,bin_addr1(2,n))
+            endif
+          end do
+        end do
+
+        do nele=1,grid2_size
+          do n=1,num_srch_bins
+            if (grid2_bound_box(1,nele) <= bin_lats(2,n) .and. &
+                grid2_bound_box(2,nele) >= bin_lats(1,n) .and. &
+                grid2_bound_box(3,nele) <= bin_lons(2,n) .and. &
+                grid2_bound_box(4,nele) >= bin_lons(1,n)) then
+              bin_addr2(1,n) = min(nele,bin_addr2(1,n))
+              bin_addr2(2,n) = max(nele,bin_addr2(2,n))
+            endif
+          end do
+        end do
+
+      case default
+        stop 'unknown search restriction method'
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine grid_init
+
+!***********************************************************************
+
+      end module grids
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/iounits.f90
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/iounits.f90	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/iounits.f90	(revision 2352)
@@ -0,0 +1,154 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module is a dynamic I/O unit manager.  It keeps track of
+!     which units are in use and reserves units for stdin, stdout, and
+!     stderr.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: iounits.f,v 1.2 2000/04/19 21:56:25 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module iounits
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod   ! defines data types
+
+      implicit none
+
+!-----------------------------------------------------------------------
+
+      logical (kind=log_kind), dimension(99), save :: &
+          unit_free   ! flags to determine whether unit is free for use
+
+      integer (kind=int_kind), parameter :: &
+          stdin  = 5,  & ! reserves unit for standard input
+          stdout = 6,  & ! reserves unit for standard output
+          stderr = 6  ! reserves unit for standard error
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine get_unit(iunit)
+
+!-----------------------------------------------------------------------
+!
+!     This routine returns the next available I/O unit number.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(out) :: &
+           iunit   ! next free I/O unit
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n
+
+      logical (kind=log_kind), save :: first_call = .true.
+
+!-----------------------------------------------------------------------
+!
+!     if this is the first call, reserve stdout, stdin and stderr
+!
+!-----------------------------------------------------------------------
+
+      if (first_call) then
+        unit_free = .true.
+        unit_free(stdin)  = .false.
+        unit_free(stdout) = .false.
+        unit_free(stderr) = .false.
+        first_call = .false.
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     search for next available unit
+!
+!-----------------------------------------------------------------------
+
+      srch_unit: do n=1,99
+        if (unit_free(n)) then
+          iunit = n
+          unit_free(n) = .false.
+          exit srch_unit
+        endif
+      end do srch_unit
+
+!-----------------------------------------------------------------------
+
+      end subroutine get_unit
+
+!***********************************************************************
+
+      subroutine release_unit(iunit)
+
+!-----------------------------------------------------------------------
+!
+!     This routine releases the specified unit and closes the file.
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) :: &
+           iunit   ! I/O unit to release
+
+!-----------------------------------------------------------------------
+!
+!     closes I/O unit and declares it free
+!
+!-----------------------------------------------------------------------
+
+      unit_free(iunit) = .true.
+      close(iunit)
+
+!-----------------------------------------------------------------------
+
+      end subroutine release_unit
+
+!***********************************************************************
+
+      end module iounits
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/kinds_mod.f90
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/kinds_mod.f90	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/kinds_mod.f90	(revision 2352)
@@ -0,0 +1,53 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module defines the F90 kind parameter for common data types.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: kinds_mod.f,v 1.2 2000/04/19 21:56:25 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module kinds_mod
+
+!-----------------------------------------------------------------------
+
+      implicit none
+      save
+
+!-----------------------------------------------------------------------
+
+      integer, parameter :: char_len  = 80, &
+                            int_kind  = kind(1), &
+                            log_kind  = kind(.true.), &
+                            real_kind = selected_real_kind(6), &
+                            dbl_kind  = selected_real_kind(13)
+
+!-----------------------------------------------------------------------
+
+      end module kinds_mod
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/netcdf_mod.f90
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/netcdf_mod.f90	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/netcdf_mod.f90	(revision 2352)
@@ -0,0 +1,84 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module contains the netCDF include file and a netcdf error
+!     handling routine.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: netcdf.f,v 1.2 2000/04/19 21:56:25 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module netcdf_mod
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod
+      use constants
+
+      implicit none
+
+      include 'netcdf.inc'
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine netcdf_error_handler(istat, mess)
+
+!-----------------------------------------------------------------------
+!
+!     This routine provides a simple interface to netCDF error message
+!     routine.
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::  &
+          istat   ! integer status returned by netCDF function call
+      character (len=*), intent(in), optional :: mess
+
+!-----------------------------------------------------------------------
+
+      if (istat /= NF_NOERR) then
+       if (present(mess)) then
+         print *,'Error in netCDF: ',nf_strerror(istat), 'Message: ',mess
+       else
+         print *,'Error in netCDF: ',nf_strerror(istat)
+       endif
+        stop
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine netcdf_error_handler
+
+!***********************************************************************
+
+      end module netcdf_mod
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/remap.f90
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/remap.f90	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/remap.f90	(revision 2352)
@@ -0,0 +1,165 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this routine performs a remapping based on addresses and weights
+!     computed in a setup phase
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap.f,v 1.5 2000/04/19 21:56:25 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_mod
+
+!-----------------------------------------------------------------------
+!
+!     this module contains the routines for performing the actual
+!     remappings
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod    ! defines common data types
+      use constants    ! defines common constants
+
+      implicit none
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap(dst_array, map_wts, dst_add, src_add,  &
+                       src_array, src_grad1, src_grad2, src_grad3)
+
+!-----------------------------------------------------------------------
+!
+!     performs the remapping based on weights computed elsewhere
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input arrays
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(:), intent(in) :: &
+           dst_add,      & ! destination address for each link
+           src_add      ! source      address for each link
+
+      real (kind=dbl_kind), dimension(:,:), intent(in) :: &
+           map_wts      ! remapping weights for each link
+
+      real (kind=dbl_kind), dimension(:), intent(in) :: &
+           src_array    ! array with source field to be remapped
+
+      real (kind=dbl_kind), dimension(:), intent(in), optional :: &
+           src_grad1     & ! gradient arrays on source grid necessary for
+      ,    src_grad2     & ! higher-order remappings
+      ,    src_grad3
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), dimension(:), intent(inout) :: &
+           dst_array    ! array for remapped field on destination grid
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, iorder
+
+!-----------------------------------------------------------------------
+!
+!     check the order of the interpolation
+!
+!-----------------------------------------------------------------------
+
+      if (present(src_grad1)) then
+        iorder = 2
+      else
+        iorder = 1
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     first order remapping
+!
+!-----------------------------------------------------------------------
+
+      dst_array = zero
+
+      select case (iorder)
+      case(1)
+
+        do n=1,size(dst_add)
+          dst_array(dst_add(n)) = dst_array(dst_add(n)) +  &
+                                  src_array(src_add(n))*map_wts(1,n)
+        end do
+
+!-----------------------------------------------------------------------
+!
+!     second order remapping
+!
+!-----------------------------------------------------------------------
+
+      case(2)
+
+        if (size(map_wts,DIM=1) == 3) then
+          do n=1,size(dst_add)
+            dst_array(dst_add(n)) = dst_array(dst_add(n)) + &
+                                    src_array(src_add(n))*map_wts(1,n) + &
+                                    src_grad1(src_add(n))*map_wts(2,n) + &
+                                    src_grad2(src_add(n))*map_wts(3,n)
+          end do
+        else if (size(map_wts,DIM=1) == 4) then
+          do n=1,size(dst_add)
+            dst_array(dst_add(n)) = dst_array(dst_add(n)) + &
+                                    src_array(src_add(n))*map_wts(1,n) + &
+                                    src_grad1(src_add(n))*map_wts(2,n) + &
+                                    src_grad2(src_add(n))*map_wts(3,n) + &
+                                    src_grad3(src_add(n))*map_wts(4,n)
+          end do
+        endif
+
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine remap
+
+!***********************************************************************
+
+      end module remap_mod
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/remap_bicubic.f90
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/remap_bicubic.f90	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/remap_bicubic.f90	(revision 2352)
@@ -0,0 +1,844 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary routines for performing an 
+!     bicubic interpolation.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_bicubic.f,v 1.5 2001/08/22 18:20:41 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_bicubic
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common constants
+      use grids         ! module containing grid info
+      use remap_vars    ! module containing remap info
+
+      implicit none
+
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter :: &
+          max_iter = 100   ! max iteration count for i,j iteration
+
+      real (kind=dbl_kind), parameter :: &
+           converge = 1.e-10_dbl_kind  ! convergence criterion
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap_bicub
+
+!-----------------------------------------------------------------------
+!
+!     this routine computes the weights for a bicubic interpolation.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n,icount, &
+           dst_add,         & ! destination address
+           iter,            & ! iteration counter
+           nmap            ! index of current map being computed
+
+      integer (kind=int_kind), dimension(4) ::  &
+           src_add         ! address for the four source points
+
+      real (kind=dbl_kind), dimension(4)  :: &
+           src_lats,        & ! latitudes  of four bilinear corners
+           src_lons        ! longitudes of four bilinear corners
+
+      real (kind=dbl_kind), dimension(4,4)  :: &
+           wgts            ! bicubic weights for four corners
+
+      real (kind=dbl_kind) :: &
+           plat, plon,        & ! lat/lon coords of destination point
+           iguess, jguess,    & ! current guess for bilinear coordinate
+           thguess, phguess,  & ! current guess for lat/lon coordinate
+           deli, delj,        & ! corrections to i,j
+           dth1, dth2, dth3,  & ! some latitude  differences
+           dph1, dph2, dph3,  & ! some longitude differences
+           dthp, dphp,        & ! difference between point and sw corner
+           mat1, mat2, mat3, mat4,  & ! matrix elements
+           determinant,       & ! matrix determinant
+           sum_wgts,          & ! sum of weights for normalization
+           w1,w2,w3,w4,w5,w6,w7,w8,  & ! 16 bicubic weight functions
+           w9,w10,w11,w12,w13,w14,w15,w16
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid1 to grid2
+!
+!-----------------------------------------------------------------------
+
+      nmap = 1
+      if (grid1_rank /= 2) then
+        stop 'Can not do bicubic interpolation when grid_rank /= 2'
+      endif
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop1: do dst_add = 1, grid2_size
+
+        if (.not. grid2_mask(dst_add)) cycle grid_loop1
+
+        plat = grid2_center_lat(dst_add)
+        plon = grid2_center_lon(dst_add)
+
+!-----------------------------------------------------------------------
+!
+!       find nearest square of grid points on source grid
+!
+!-----------------------------------------------------------------------
+
+        call grid_search_bicub(src_add, src_lats, src_lons,  &
+                               plat, plon, grid1_dims, &
+                               grid1_center_lat, grid1_center_lon, &
+                               grid1_bound_box, bin_addr1, bin_addr2)
+
+        !***
+        !*** check to see if points are land points
+        !***
+
+        if (src_add(1) > 0) then
+          do n=1,4
+            if (.not. grid1_mask(src_add(n))) src_add(1) = 0
+          end do
+        endif
+
+!-----------------------------------------------------------------------
+!
+!       if point found, find local i,j coordinates for weights
+!
+!-----------------------------------------------------------------------
+
+        if (src_add(1) > 0) then
+
+          grid2_frac(dst_add) = one
+
+          !***
+          !*** iterate to find i,j for bicubic approximation
+          !***
+
+          dth1 = src_lats(2) - src_lats(1)
+          dth2 = src_lats(4) - src_lats(1)
+          dth3 = src_lats(3) - src_lats(2) - dth2
+
+          dph1 = src_lons(2) - src_lons(1)
+          dph2 = src_lons(4) - src_lons(1)
+          dph3 = src_lons(3) - src_lons(2)
+
+          if (dph1 >  three*pih) dph1 = dph1 - pi2
+          if (dph2 >  three*pih) dph2 = dph2 - pi2
+          if (dph3 >  three*pih) dph3 = dph3 - pi2
+          if (dph1 < -three*pih) dph1 = dph1 + pi2
+          if (dph2 < -three*pih) dph2 = dph2 + pi2
+          if (dph3 < -three*pih) dph3 = dph3 + pi2
+
+          dph3 = dph3 - dph2
+
+          iguess = half
+          jguess = half
+
+          iter_loop1: do iter=1,max_iter
+
+            dthp = plat - src_lats(1) - dth1*iguess - &
+                          dth2*jguess - dth3*iguess*jguess
+            dphp = plon - src_lons(1)
+
+            if (dphp >  three*pih) dphp = dphp - pi2
+            if (dphp < -three*pih) dphp = dphp + pi2
+
+            dphp = dphp - dph1*iguess - dph2*jguess -  &
+                          dph3*iguess*jguess
+
+            mat1 = dth1 + dth3*jguess
+            mat2 = dth2 + dth3*iguess
+            mat3 = dph1 + dph3*jguess
+            mat4 = dph2 + dph3*iguess
+
+            determinant = mat1*mat4 - mat2*mat3
+
+            deli = (dthp*mat4 - mat2*dphp)/determinant
+            delj = (mat1*dphp - dthp*mat3)/determinant
+
+            if (abs(deli) < converge .and.  &
+                abs(delj) < converge) exit iter_loop1
+
+            iguess = iguess + deli
+            jguess = jguess + delj
+
+          end do iter_loop1
+
+          if (iter <= max_iter) then
+
+!-----------------------------------------------------------------------
+!
+!           successfully found i,j - compute weights
+!
+!-----------------------------------------------------------------------
+
+            wgts(1,1) = (one - jguess**2*(three-two*jguess))* &
+                        (one - iguess**2*(three-two*iguess))
+            wgts(1,2) = (one - jguess**2*(three-two*jguess))* &
+                               iguess**2*(three-two*iguess)
+            wgts(1,3) =        jguess**2*(three-two*jguess)* &
+                               iguess**2*(three-two*iguess)
+            wgts(1,4) =        jguess**2*(three-two*jguess)* &
+                        (one - iguess**2*(three-two*iguess))
+            wgts(2,1) = (one - jguess**2*(three-two*jguess))* &
+                               iguess*(iguess-one)**2
+            wgts(2,2) = (one - jguess**2*(three-two*jguess))* &
+                               iguess**2*(iguess-one)
+            wgts(2,3) =        jguess**2*(three-two*jguess)* &
+                               iguess**2*(iguess-one)
+            wgts(2,4) =        jguess**2*(three-two*jguess)* &
+                               iguess*(iguess-one)**2
+            wgts(3,1) =        jguess*(jguess-one)**2* &
+                        (one - iguess**2*(three-two*iguess))
+            wgts(3,2) =        jguess*(jguess-one)**2* &
+                               iguess**2*(three-two*iguess)
+            wgts(3,3) =        jguess**2*(jguess-one)* &
+                               iguess**2*(three-two*iguess)
+            wgts(3,4) =        jguess**2*(jguess-one)* &
+                        (one - iguess**2*(three-two*iguess))
+            wgts(4,1) =        iguess*(iguess-one)**2* &
+                               jguess*(jguess-one)**2
+            wgts(4,2) =        iguess**2*(iguess-one)* &
+                               jguess*(jguess-one)**2
+            wgts(4,3) =        iguess**2*(iguess-one)* &
+                               jguess**2*(jguess-one)
+            wgts(4,4) =        iguess*(iguess-one)**2* &
+                               jguess**2*(jguess-one)
+
+            call store_link_bicub(dst_add, src_add, wgts, nmap)
+
+          else
+            stop 'Iteration for i,j exceed max iteration count'
+          endif
+
+!-----------------------------------------------------------------------
+!
+!       search for bilinear failed - use a distance-weighted
+!       average instead (this is typically near the pole)
+!
+!-----------------------------------------------------------------------
+
+        else if (src_add(1) < 0) then
+
+          src_add = abs(src_add)
+
+          icount = 0
+          do n=1,4
+            if (grid1_mask(src_add(n))) then
+              icount = icount + 1
+            else
+              src_lats(n) = zero
+            endif
+          end do
+
+          if (icount > 0) then
+            !*** renormalize weights
+
+            sum_wgts = sum(src_lats)
+            wgts(1,1) = src_lats(1)/sum_wgts
+            wgts(1,2) = src_lats(2)/sum_wgts
+            wgts(1,3) = src_lats(3)/sum_wgts
+            wgts(1,4) = src_lats(4)/sum_wgts
+            wgts(2:4,:) = zero
+
+            grid2_frac(dst_add) = one
+            call store_link_bicub(dst_add, src_add, wgts, nmap)
+          endif
+
+        endif
+      end do grid_loop1
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid2 to grid1 if necessary
+!
+!-----------------------------------------------------------------------
+
+      if (num_maps > 1) then
+
+      nmap = 2
+      if (grid2_rank /= 2) then
+        stop 'Can not do bicubic interpolation when grid_rank /= 2'
+      endif
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop2: do dst_add = 1, grid1_size
+
+        if (.not. grid1_mask(dst_add)) cycle grid_loop2
+
+        plat = grid1_center_lat(dst_add)
+        plon = grid1_center_lon(dst_add)
+
+        !***
+        !*** find nearest square of grid points on source grid
+        !***
+
+        call grid_search_bicub(src_add, src_lats, src_lons,  &
+                               plat, plon, grid2_dims, &
+                               grid2_center_lat, grid2_center_lon, &
+                               grid2_bound_box, bin_addr2, bin_addr1)
+
+        !***
+        !*** check to see if points are land points
+        !***
+
+        if (src_add(1) > 0) then
+          do n=1,4
+            if (.not. grid2_mask(src_add(n))) src_add(1) = 0
+          end do
+        endif
+
+        !***
+        !*** if point found, find i,j coordinates for weights
+        !***
+
+        if (src_add(1) > 0) then
+
+          grid1_frac(dst_add) = one
+
+          !***
+          !*** iterate to find i,j for bilinear approximation
+          !***
+
+          dth1 = src_lats(2) - src_lats(1)
+          dth2 = src_lats(4) - src_lats(1)
+          dth3 = src_lats(3) - src_lats(2) - dth2
+
+          dph1 = src_lons(2) - src_lons(1)
+          dph2 = src_lons(4) - src_lons(1)
+          dph3 = src_lons(3) - src_lons(2)
+
+          if (dph1 >  pi) dph1 = dph1 - pi2
+          if (dph2 >  pi) dph2 = dph2 - pi2
+          if (dph3 >  pi) dph3 = dph3 - pi2
+          if (dph1 < -pi) dph1 = dph1 + pi2
+          if (dph2 < -pi) dph2 = dph2 + pi2
+          if (dph3 < -pi) dph3 = dph3 + pi2
+
+          dph3 = dph3 - dph2
+
+          iguess = zero
+          jguess = zero
+
+          iter_loop2: do iter=1,max_iter
+
+            dthp = plat - src_lats(1) - dth1*iguess - &
+                          dth2*jguess - dth3*iguess*jguess
+            dphp = plon - src_lons(1)
+
+            if (dphp >  pi) dphp = dphp - pi2
+            if (dphp < -pi) dphp = dphp + pi2
+
+            dphp = dphp - dph1*iguess - dph2*jguess -  &
+                          dph3*iguess*jguess
+
+            mat1 = dth1 + dth3*jguess
+            mat2 = dth2 + dth3*iguess
+            mat3 = dph1 + dph3*jguess
+            mat4 = dph2 + dph3*iguess
+
+            determinant = mat1*mat4 - mat2*mat3
+
+            deli = (dthp*mat4 - mat2*dphp)/determinant
+            delj = (mat1*dphp - dthp*mat3)/determinant
+
+            if (abs(deli) < converge .and.  &
+                abs(delj) < converge) exit iter_loop2
+
+            iguess = iguess + deli
+            jguess = jguess + delj
+
+          end do iter_loop2
+
+          if (iter <= max_iter) then
+
+            !***
+            !*** successfully found i,j - compute weights
+            !***
+
+            wgts(1,1) = (one - jguess**2*(three-two*jguess))* &
+                        (one - iguess**2*(three-two*iguess))
+            wgts(1,2) = (one - jguess**2*(three-two*jguess))* &
+                               iguess**2*(three-two*iguess)
+            wgts(1,3) =        jguess**2*(three-two*jguess)* &
+                               iguess**2*(three-two*iguess)
+            wgts(1,4) =        jguess**2*(three-two*jguess)* &
+                        (one - iguess**2*(three-two*iguess))
+            wgts(2,1) = (one - jguess**2*(three-two*jguess))* &
+                               iguess*(iguess-one)**2
+            wgts(2,2) = (one - jguess**2*(three-two*jguess))* &
+                               iguess**2*(iguess-one)
+            wgts(2,3) =        jguess**2*(three-two*jguess)* &
+                               iguess**2*(iguess-one)
+            wgts(2,4) =        jguess**2*(three-two*jguess)* &
+                               iguess*(iguess-one)**2
+            wgts(3,1) =        jguess*(jguess-one)**2* &
+                        (one - iguess**2*(three-two*iguess))
+            wgts(3,2) =        jguess*(jguess-one)**2* &
+                               iguess**2*(three-two*iguess)
+            wgts(3,3) =        jguess**2*(jguess-one)* &
+                               iguess**2*(three-two*iguess)
+            wgts(3,4) =        jguess**2*(jguess-one)* &
+                        (one - iguess**2*(three-two*iguess))
+            wgts(4,1) =        iguess*(iguess-one)**2* &
+                               jguess*(jguess-one)**2
+            wgts(4,2) =        iguess**2*(iguess-one)* &
+                               jguess*(jguess-one)**2
+            wgts(4,3) =        iguess**2*(iguess-one)* &
+                               jguess**2*(jguess-one)
+            wgts(4,4) =        iguess*(iguess-one)**2* &
+                               jguess**2*(jguess-one)
+
+            call store_link_bicub(dst_add, src_add, wgts, nmap)
+
+          else
+            stop 'Iteration for i,j exceed max iteration count'
+          endif
+
+        !***
+        !*** search for bilinear failed - us a distance-weighted
+        !*** average instead
+        !***
+
+        else if (src_add(1) < 0) then
+
+          src_add = abs(src_add)
+
+          icount = 0
+          do n=1,4
+            if (grid2_mask(src_add(n))) then
+              icount = icount + 1
+            else
+              src_lats(n) = zero
+            endif
+          end do
+
+          if (icount > 0) then
+            !*** renormalize weights
+
+            sum_wgts = sum(src_lats)
+            wgts(1,1) = src_lats(1)/sum_wgts
+            wgts(1,2) = src_lats(2)/sum_wgts
+            wgts(1,3) = src_lats(3)/sum_wgts
+            wgts(1,4) = src_lats(4)/sum_wgts
+            wgts(2:4,:) = zero
+
+            grid1_frac(dst_add) = one
+            call store_link_bicub(dst_add, src_add, wgts, nmap)
+          endif
+
+        endif
+      end do grid_loop2
+
+      endif ! nmap=2
+
+!-----------------------------------------------------------------------
+
+      end subroutine remap_bicub
+
+!***********************************************************************
+
+      subroutine grid_search_bicub(src_add, src_lats, src_lons,  &
+                                   plat, plon, src_grid_dims, &
+                                   src_center_lat, src_center_lon, &
+                                   src_bound_box, &
+                                   src_bin_add, dst_bin_add)
+
+!-----------------------------------------------------------------------
+!
+!     this routine finds the location of the search point plat, plon
+!     in the source grid and returns the corners needed for a bicubic
+!     interpolation.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(4), intent(out) :: &
+              src_add  ! address of each corner point enclosing P
+
+      real (kind=dbl_kind), dimension(4), intent(out) :: &
+              src_lats,  & ! latitudes  of the four corner points
+              src_lons  ! longitudes of the four corner points
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), intent(in) :: &
+              plat,    & ! latitude  of the search point
+              plon    ! longitude of the search point
+
+      integer (kind=int_kind), dimension(2), intent(in) :: &
+              src_grid_dims  ! size of each src grid dimension
+
+      real (kind=dbl_kind), dimension(:), intent(in) :: &
+              src_center_lat,  & ! latitude  of each src grid center 
+              src_center_lon  ! longitude of each src grid center
+
+      real (kind=dbl_kind), dimension(:,:), intent(in) :: &
+              src_bound_box   ! bounding box for src grid search
+
+      integer (kind=int_kind), dimension(:,:), intent(in) :: &
+              src_bin_add,     & ! search bins for restricting
+              dst_bin_add     ! searches
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, next_n, srch_add,    & ! dummy indices
+          nx, ny,             & ! dimensions of src grid
+          min_add, max_add,   & ! addresses for restricting search
+          i, j, jp1, ip1, n_add, e_add, ne_add  ! addresses
+
+      real (kind=dbl_kind) ::   & ! vectors for cross-product check
+            vec1_lat, vec1_lon, &
+            vec2_lat, vec2_lon, cross_product, cross_product_last, &
+            coslat_dst, sinlat_dst, coslon_dst, sinlon_dst, &
+            dist_min, distance ! for computing dist-weighted avg
+
+!-----------------------------------------------------------------------
+!
+!     restrict search first using search bins. 
+!
+!-----------------------------------------------------------------------
+
+      src_add = 0
+
+      min_add = size(src_center_lat)
+      max_add = 1
+      do n=1,num_srch_bins
+        if (plat >= bin_lats(1,n) .and. plat <= bin_lats(2,n) .and. &
+            plon >= bin_lons(1,n) .and. plon <= bin_lons(2,n)) then
+          min_add = min(min_add, src_bin_add(1,n))
+          max_add = max(max_add, src_bin_add(2,n))
+        endif
+      end do
+ 
+!-----------------------------------------------------------------------
+!
+!     now perform a more detailed search 
+!
+!-----------------------------------------------------------------------
+
+      nx = src_grid_dims(1)
+      ny = src_grid_dims(2)
+
+      srch_loop: do srch_add = min_add,max_add
+
+        if (plat <= src_bound_box(2,srch_add) .and.  &
+            plat >= src_bound_box(1,srch_add) .and. &
+            plon <= src_bound_box(4,srch_add) .and.  &
+            plon >= src_bound_box(3,srch_add)) then
+
+          !***
+          !*** we are within bounding box so get really serious
+          !***
+
+          !*** find N,S and NE points to this grid point
+
+          j = (srch_add - 1)/nx +1
+          i = srch_add - (j-1)*nx
+
+          if (i < nx) then
+            ip1 = i + 1
+          else
+            ip1 = 1
+          endif
+
+          if (j < ny) then
+            jp1 = j+1
+          else
+            jp1 = 1
+          endif
+
+          n_add = (jp1 - 1)*nx + i
+          e_add = (j - 1)*nx + ip1
+          ne_add = (jp1 - 1)*nx + ip1
+
+          !***
+          !*** find N,S and NE lat/lon coords and check bounding box
+          !***
+
+          src_lats(1) = src_center_lat(srch_add)
+          src_lats(2) = src_center_lat(e_add)
+          src_lats(3) = src_center_lat(ne_add)
+          src_lats(4) = src_center_lat(n_add)
+
+          src_lons(1) = src_center_lon(srch_add)
+          src_lons(2) = src_center_lon(e_add)
+          src_lons(3) = src_center_lon(ne_add)
+          src_lons(4) = src_center_lon(n_add)
+
+          !***
+          !*** for consistency, we must make sure all lons are in
+          !*** same 2pi interval
+          !***
+
+          vec1_lon = src_lons(1) - plon
+          if (vec1_lon > pi) then
+            src_lons(1) = src_lons(1) - pi2
+          else if (vec1_lon < -pi) then
+            src_lons(1) = src_lons(1) + pi2
+          endif
+          do n=2,4
+            vec1_lon = src_lons(n) - src_lons(1)
+            if (vec1_lon > pi) then
+              src_lons(n) = src_lons(n) - pi2
+            else if (vec1_lon < -pi) then
+              src_lons(n) = src_lons(n) + pi2
+            endif
+          end do
+
+          corner_loop: do n=1,4
+            next_n = MOD(n,4) + 1
+
+            !***
+            !*** here we take the cross product of the vector making 
+            !*** up each box side with the vector formed by the vertex
+            !*** and search point.  if all the cross products are 
+            !*** same sign, the point is contained in the box.
+            !***
+
+            vec1_lat = src_lats(next_n) - src_lats(n)
+            vec1_lon = src_lons(next_n) - src_lons(n)
+            vec2_lat = plat - src_lats(n)
+            vec2_lon = plon - src_lons(n)
+
+            !***
+            !*** check for 0,2pi crossings
+            !***
+
+            if (vec1_lon >  three*pih) then
+              vec1_lon = vec1_lon - pi2
+            else if (vec1_lon < -three*pih) then
+              vec1_lon = vec1_lon + pi2
+            endif
+            if (vec2_lon >  three*pih) then
+              vec2_lon = vec2_lon - pi2
+            else if (vec2_lon < -three*pih) then
+              vec2_lon = vec2_lon + pi2
+            endif
+
+            cross_product = vec1_lon*vec2_lat - vec2_lon*vec1_lat
+
+            !***
+            !*** if cross product is less than zero, this cell
+            !*** doesn't work
+            !***
+
+            if (n==1) cross_product_last = cross_product
+            if (cross_product*cross_product_last < zero) then
+              exit corner_loop
+            else
+              cross_product_last = cross_product
+            endif
+
+          end do corner_loop
+
+          !***
+          !*** if cross products all positive, we found the location
+          !***
+
+          if (n > 4) then
+            src_add(1) = srch_add
+            src_add(2) = e_add
+            src_add(3) = ne_add
+            src_add(4) = n_add
+
+            return
+          endif
+
+          !***
+          !*** otherwise move on to next cell
+          !***
+
+        endif !bounding box check
+      end do srch_loop
+
+      !***
+      !*** if no cell found, point is likely either in a box that
+      !*** straddles either pole or is outside the grid.  fall back
+      !*** to a distance-weighted average of the four closest
+      !*** points.  go ahead and compute weights here, but store
+      !*** in src_lats and return -add to prevent the parent
+      !*** routine from computing bilinear weights
+      !***
+
+      coslat_dst = cos(plat)
+      sinlat_dst = sin(plat)
+      coslon_dst = cos(plon)
+      sinlon_dst = sin(plon)
+
+      dist_min = bignum
+      src_lats = bignum
+      do srch_add = min_add,max_add
+        distance = acos(coslat_dst*cos(src_center_lat(srch_add))* &
+                       (coslon_dst*cos(src_center_lon(srch_add)) + &
+                        sinlon_dst*sin(src_center_lon(srch_add)))+ &
+                        sinlat_dst*sin(src_center_lat(srch_add)))
+
+        if (distance < dist_min) then
+          sort_loop: do n=1,4
+            if (distance < src_lats(n)) then
+              do i=4,n+1,-1
+                src_add (i) = src_add (i-1)
+                src_lats(i) = src_lats(i-1)
+              end do
+              src_add (n) = -srch_add
+              src_lats(n) = distance
+              dist_min = src_lats(4)
+              exit sort_loop
+            endif
+          end do sort_loop
+        endif
+      end do
+
+      src_lons = one/(src_lats + tiny)
+      distance = sum(src_lons)
+      src_lats = src_lons/distance
+
+!-----------------------------------------------------------------------
+
+      end subroutine grid_search_bicub 
+
+!***********************************************************************
+
+      subroutine store_link_bicub(dst_add, src_add, weights, nmap)
+
+!-----------------------------------------------------------------------
+!
+!     this routine stores the address and weight for four links 
+!     associated with one destination point in the appropriate address 
+!     and weight arrays and resizes those arrays if necessary.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) :: &
+              dst_add,   & ! address on destination grid
+              nmap      ! identifies which direction for mapping
+
+      integer (kind=int_kind), dimension(4), intent(in) :: &
+              src_add   ! addresses on source grid
+
+      real (kind=dbl_kind), dimension(4,4), intent(in) :: &
+              weights ! array of remapping weights for these links
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n,  & ! dummy index
+             num_links_old          ! placeholder for old link number
+
+!-----------------------------------------------------------------------
+!
+!     increment number of links and check to see if remap arrays need
+!     to be increased to accomodate the new link.  then store the
+!     link.
+!
+!-----------------------------------------------------------------------
+
+      select case (nmap)
+      case(1)
+
+        num_links_old  = num_links_map1
+        num_links_map1 = num_links_old + 4
+
+        if (num_links_map1 > max_links_map1)  &
+           call resize_remap_vars(1,resize_increment)
+
+        do n=1,4
+          grid1_add_map1(num_links_old+n) = src_add(n)
+          grid2_add_map1(num_links_old+n) = dst_add
+          wts_map1    (:,num_links_old+n) = weights(:,n)
+        end do
+
+      case(2)
+
+        num_links_old  = num_links_map2
+        num_links_map2 = num_links_old + 4
+
+        if (num_links_map2 > max_links_map2)  &
+           call resize_remap_vars(2,resize_increment)
+
+        do n=1,4
+          grid1_add_map2(num_links_old+n) = dst_add
+          grid2_add_map2(num_links_old+n) = src_add(n)
+          wts_map2    (:,num_links_old+n) = weights(:,n)
+        end do
+
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine store_link_bicub
+
+!***********************************************************************
+
+      end module remap_bicubic
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/remap_bilinear.f90
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/remap_bilinear.f90	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/remap_bilinear.f90	(revision 2352)
@@ -0,0 +1,781 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary routines for performing an 
+!     bilinear interpolation.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_bilinear.f,v 1.6 2001/08/22 18:20:40 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_bilinear
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common constants
+      use grids         ! module containing grid info
+      use remap_vars    ! module containing remap info
+
+      implicit none
+
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter :: &
+          max_iter = 100   ! max iteration count for i,j iteration
+
+      real (kind=dbl_kind), parameter :: &
+           converge = 1.e-10_dbl_kind  ! convergence criterion
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap_bilin
+
+!-----------------------------------------------------------------------
+!
+!     this routine computes the weights for a bilinear interpolation.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n,icount, &
+           dst_add,         & ! destination address
+           iter,            & ! iteration counter
+           nmap            ! index of current map being computed
+
+      integer (kind=int_kind), dimension(4) ::  &
+           src_add         ! address for the four source points
+
+      real (kind=dbl_kind), dimension(4)  :: &
+           src_lats,        & ! latitudes  of four bilinear corners
+           src_lons,        & ! longitudes of four bilinear corners
+           wgts            ! bilinear weights for four corners
+
+      real (kind=dbl_kind) :: &
+           plat, plon,        & ! lat/lon coords of destination point
+           iguess, jguess,    & ! current guess for bilinear coordinate
+           thguess, phguess,  & ! current guess for lat/lon coordinate
+           deli, delj,        & ! corrections to i,j
+           dth1, dth2, dth3,  & ! some latitude  differences
+           dph1, dph2, dph3,  & ! some longitude differences
+           dthp, dphp,        & ! difference between point and sw corner
+           mat1, mat2, mat3, mat4,  & ! matrix elements
+           determinant,       & ! matrix determinant
+           sum_wgts          ! sum of weights for normalization
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid1 to grid2
+!
+!-----------------------------------------------------------------------
+
+      nmap = 1
+      if (grid1_rank /= 2) then
+        stop 'Can not do bilinear interpolation when grid_rank /= 2'
+      endif
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop1: do dst_add = 1, grid2_size
+
+        if (.not. grid2_mask(dst_add)) cycle grid_loop1
+
+        plat = grid2_center_lat(dst_add)
+        plon = grid2_center_lon(dst_add)
+
+        !***
+        !*** find nearest square of grid points on source grid
+        !***
+
+        call grid_search_bilin(src_add, src_lats, src_lons,  &
+                               plat, plon, grid1_dims, &
+                               grid1_center_lat, grid1_center_lon, &
+                               grid1_bound_box, bin_addr1, bin_addr2)
+
+        !***
+        !*** check to see if points are land points
+        !***
+
+        if (src_add(1) > 0) then
+          do n=1,4
+            if (.not. grid1_mask(src_add(n))) src_add(1) = 0
+          end do
+        endif
+
+        !***
+        !*** if point found, find local i,j coordinates for weights
+        !***
+
+        if (src_add(1) > 0) then
+
+          grid2_frac(dst_add) = one
+
+          !***
+          !*** iterate to find i,j for bilinear approximation
+          !***
+
+          dth1 = src_lats(2) - src_lats(1)
+          dth2 = src_lats(4) - src_lats(1)
+          dth3 = src_lats(3) - src_lats(2) - dth2
+
+          dph1 = src_lons(2) - src_lons(1)
+          dph2 = src_lons(4) - src_lons(1)
+          dph3 = src_lons(3) - src_lons(2)
+
+          if (dph1 >  three*pih) dph1 = dph1 - pi2
+          if (dph2 >  three*pih) dph2 = dph2 - pi2
+          if (dph3 >  three*pih) dph3 = dph3 - pi2
+          if (dph1 < -three*pih) dph1 = dph1 + pi2
+          if (dph2 < -three*pih) dph2 = dph2 + pi2
+          if (dph3 < -three*pih) dph3 = dph3 + pi2
+
+          dph3 = dph3 - dph2
+
+          iguess = half
+          jguess = half
+
+          iter_loop1: do iter=1,max_iter
+
+            dthp = plat - src_lats(1) - dth1*iguess - &
+                          dth2*jguess - dth3*iguess*jguess
+            dphp = plon - src_lons(1)
+
+            if (dphp >  three*pih) dphp = dphp - pi2
+            if (dphp < -three*pih) dphp = dphp + pi2
+
+            dphp = dphp - dph1*iguess - dph2*jguess -  &
+                          dph3*iguess*jguess
+
+            mat1 = dth1 + dth3*jguess
+            mat2 = dth2 + dth3*iguess
+            mat3 = dph1 + dph3*jguess
+            mat4 = dph2 + dph3*iguess
+
+            determinant = mat1*mat4 - mat2*mat3
+
+            deli = (dthp*mat4 - mat2*dphp)/determinant
+            delj = (mat1*dphp - dthp*mat3)/determinant
+
+            if (abs(deli) < converge .and.  &
+                abs(delj) < converge) exit iter_loop1
+
+            iguess = iguess + deli
+            jguess = jguess + delj
+
+          end do iter_loop1
+
+          if (iter <= max_iter) then
+
+            !***
+            !*** successfully found i,j - compute weights
+            !***
+
+            wgts(1) = (one-iguess)*(one-jguess)
+            wgts(2) = iguess*(one-jguess)
+            wgts(3) = iguess*jguess
+            wgts(4) = (one-iguess)*jguess
+
+            call store_link_bilin(dst_add, src_add, wgts, nmap)
+
+          else
+            print *,'Point coords: ',plat,plon
+            print *,'Dest grid lats: ',src_lats
+            print *,'Dest grid lons: ',src_lons
+            print *,'Dest grid addresses: ',src_add
+            print *,'Current i,j : ',iguess, jguess
+            stop 'Iteration for i,j exceed max iteration count'
+          endif
+
+        !***
+        !*** search for bilinear failed - use a distance-weighted
+        !*** average instead (this is typically near the pole)
+        !***
+
+        else if (src_add(1) < 0) then
+
+          src_add = abs(src_add)
+          icount = 0
+          do n=1,4
+            if (grid1_mask(src_add(n))) then
+              icount = icount + 1
+            else
+              src_lats(n) = zero
+            endif
+          end do
+
+          if (icount > 0) then
+            !*** renormalize weights
+
+            sum_wgts = sum(src_lats)
+            wgts(1) = src_lats(1)/sum_wgts
+            wgts(2) = src_lats(2)/sum_wgts
+            wgts(3) = src_lats(3)/sum_wgts
+            wgts(4) = src_lats(4)/sum_wgts
+
+            grid2_frac(dst_add) = one
+            call store_link_bilin(dst_add, src_add, wgts, nmap)
+          endif
+
+        endif
+      end do grid_loop1
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid2 to grid1 if necessary
+!
+!-----------------------------------------------------------------------
+
+      if (num_maps > 1) then
+
+      nmap = 2
+      if (grid2_rank /= 2) then
+        stop 'Can not do bilinear interpolation when grid_rank /= 2'
+      endif
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop2: do dst_add = 1, grid1_size
+
+        if (.not. grid1_mask(dst_add)) cycle grid_loop2
+
+        plat = grid1_center_lat(dst_add)
+        plon = grid1_center_lon(dst_add)
+
+        !***
+        !*** find nearest square of grid points on source grid
+        !***
+
+        call grid_search_bilin(src_add, src_lats, src_lons,  &
+                               plat, plon, grid2_dims, &
+                               grid2_center_lat, grid2_center_lon, &
+                               grid2_bound_box, bin_addr2, bin_addr1)
+
+        !***
+        !*** check to see if points are land points
+        !***
+
+        if (src_add(1) > 0) then
+          do n=1,4
+            if (.not. grid2_mask(src_add(n))) src_add(1) = 0
+          end do
+        endif
+
+        !***
+        !*** if point found, find i,j coordinates for weights
+        !***
+
+        if (src_add(1) > 0) then
+
+          grid1_frac(dst_add) = one
+
+          !***
+          !*** iterate to find i,j for bilinear approximation
+          !***
+
+          dth1 = src_lats(2) - src_lats(1)
+          dth2 = src_lats(4) - src_lats(1)
+          dth3 = src_lats(3) - src_lats(2) - dth2
+
+          dph1 = src_lons(2) - src_lons(1)
+          dph2 = src_lons(4) - src_lons(1)
+          dph3 = src_lons(3) - src_lons(2)
+
+          if (dph1 >  pi) dph1 = dph1 - pi2
+          if (dph2 >  pi) dph2 = dph2 - pi2
+          if (dph3 >  pi) dph3 = dph3 - pi2
+          if (dph1 < -pi) dph1 = dph1 + pi2
+          if (dph2 < -pi) dph2 = dph2 + pi2
+          if (dph3 < -pi) dph3 = dph3 + pi2
+
+          dph3 = dph3 - dph2
+
+          iguess = zero
+          jguess = zero
+
+          iter_loop2: do iter=1,max_iter
+
+            dthp = plat - src_lats(1) - dth1*iguess - &
+                          dth2*jguess - dth3*iguess*jguess
+            dphp = plon - src_lons(1)
+
+            if (dphp >  pi) dphp = dphp - pi2
+            if (dphp < -pi) dphp = dphp + pi2
+
+            dphp = dphp - dph1*iguess - dph2*jguess -  &
+                          dph3*iguess*jguess
+
+            mat1 = dth1 + dth3*jguess
+            mat2 = dth2 + dth3*iguess
+            mat3 = dph1 + dph3*jguess
+            mat4 = dph2 + dph3*iguess
+
+            determinant = mat1*mat4 - mat2*mat3
+
+            deli = (dthp*mat4 - mat2*dphp)/determinant
+            delj = (mat1*dphp - dthp*mat3)/determinant
+
+            if (abs(deli) < converge .and.  &
+                abs(delj) < converge) exit iter_loop2
+
+            iguess = iguess + deli
+            jguess = jguess + delj
+
+          end do iter_loop2
+
+          if (iter <= max_iter) then
+
+            !***
+            !*** successfully found i,j - compute weights
+            !***
+
+            wgts(1) = (one-iguess)*(one-jguess)
+            wgts(2) = iguess*(one-jguess)
+            wgts(3) = iguess*jguess
+            wgts(4) = (one-iguess)*jguess
+
+            call store_link_bilin(dst_add, src_add, wgts, nmap)
+
+          else
+            print *,'Point coords: ',plat,plon
+            print *,'Dest grid lats: ',src_lats
+            print *,'Dest grid lons: ',src_lons
+            print *,'Dest grid addresses: ',src_add
+            print *,'Current i,j : ',iguess, jguess
+            stop 'Iteration for i,j exceed max iteration count'
+          endif
+
+        !***
+        !*** search for bilinear failed - us a distance-weighted
+        !*** average instead
+        !***
+
+        else if (src_add(1) < 0) then
+
+          src_add = abs(src_add)
+          icount = 0
+          do n=1,4
+            if (grid2_mask(src_add(n))) then
+              icount = icount + 1
+            else
+              src_lats(n) = zero
+            endif
+          end do
+
+          if (icount > 0) then
+            !*** renormalize weights
+
+            sum_wgts = sum(src_lats)
+            wgts(1) = src_lats(1)/sum_wgts
+            wgts(2) = src_lats(2)/sum_wgts
+            wgts(3) = src_lats(3)/sum_wgts
+            wgts(4) = src_lats(4)/sum_wgts
+
+            grid1_frac(dst_add) = one
+            call store_link_bilin(dst_add, src_add, wgts, nmap)
+          endif
+
+        endif
+      end do grid_loop2
+
+      endif ! nmap=2
+
+!-----------------------------------------------------------------------
+
+      end subroutine remap_bilin
+
+!***********************************************************************
+
+      subroutine grid_search_bilin(src_add, src_lats, src_lons,  &
+                                   plat, plon, src_grid_dims, &
+                                   src_center_lat, src_center_lon, &
+                                   src_grid_bound_box, &
+                                   src_bin_add, dst_bin_add)
+
+!-----------------------------------------------------------------------
+!
+!     this routine finds the location of the search point plat, plon
+!     in the source grid and returns the corners needed for a bilinear
+!     interpolation.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(4), intent(out) :: &
+              src_add  ! address of each corner point enclosing P
+
+      real (kind=dbl_kind), dimension(4), intent(out) :: &
+              src_lats,  & ! latitudes  of the four corner points
+              src_lons  ! longitudes of the four corner points
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), intent(in) :: &
+              plat,    & ! latitude  of the search point
+              plon    ! longitude of the search point
+
+      integer (kind=int_kind), dimension(2), intent(in) :: &
+              src_grid_dims  ! size of each src grid dimension
+
+      real (kind=dbl_kind), dimension(:), intent(in) :: &
+              src_center_lat,  & ! latitude  of each src grid center 
+              src_center_lon  ! longitude of each src grid center
+
+      real (kind=dbl_kind), dimension(:,:), intent(in) :: &
+              src_grid_bound_box ! bound box for source grid
+
+      integer (kind=int_kind), dimension(:,:), intent(in) :: &
+              src_bin_add,     & ! latitude bins for restricting
+              dst_bin_add     ! searches
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, next_n, srch_add,    & ! dummy indices
+          nx, ny,             & ! dimensions of src grid
+          min_add, max_add,   & ! addresses for restricting search
+          i, j, jp1, ip1, n_add, e_add, ne_add  ! addresses
+
+      real (kind=dbl_kind) ::   & ! vectors for cross-product check
+            vec1_lat, vec1_lon, &
+            vec2_lat, vec2_lon, cross_product, cross_product_last, &
+            coslat_dst, sinlat_dst, coslon_dst, sinlon_dst, &
+            dist_min, distance ! for computing dist-weighted avg
+
+!-----------------------------------------------------------------------
+!
+!     restrict search first using bins
+!
+!-----------------------------------------------------------------------
+
+      src_add = 0
+
+      min_add = size(src_center_lat)
+      max_add = 1
+      do n=1,num_srch_bins
+        if (plat >= bin_lats(1,n) .and. plat <= bin_lats(2,n) .and. &
+            plon >= bin_lons(1,n) .and. plon <= bin_lons(2,n)) then
+          min_add = min(min_add, src_bin_add(1,n))
+          max_add = max(max_add, src_bin_add(2,n))
+        endif
+      end do
+ 
+!-----------------------------------------------------------------------
+!
+!     now perform a more detailed search 
+!
+!-----------------------------------------------------------------------
+
+      nx = src_grid_dims(1)
+      ny = src_grid_dims(2)
+
+      srch_loop: do srch_add = min_add,max_add
+
+        !*** first check bounding box
+
+        if (plat <= src_grid_bound_box(2,srch_add) .and.  &
+            plat >= src_grid_bound_box(1,srch_add) .and. &
+            plon <= src_grid_bound_box(4,srch_add) .and.  &
+            plon >= src_grid_bound_box(3,srch_add)) then
+
+          !***
+          !*** we are within bounding box so get really serious
+          !***
+
+          !*** determine neighbor addresses
+
+          j = (srch_add - 1)/nx +1
+          i = srch_add - (j-1)*nx
+
+          if (i < nx) then
+            ip1 = i + 1
+          else
+            ip1 = 1
+          endif
+
+          if (j < ny) then
+            jp1 = j+1
+          else
+            jp1 = 1
+          endif
+
+          n_add = (jp1 - 1)*nx + i
+          e_add = (j - 1)*nx + ip1
+          ne_add = (jp1 - 1)*nx + ip1
+
+          src_lats(1) = src_center_lat(srch_add)
+          src_lats(2) = src_center_lat(e_add)
+          src_lats(3) = src_center_lat(ne_add)
+          src_lats(4) = src_center_lat(n_add)
+
+          src_lons(1) = src_center_lon(srch_add)
+          src_lons(2) = src_center_lon(e_add)
+          src_lons(3) = src_center_lon(ne_add)
+          src_lons(4) = src_center_lon(n_add)
+
+          !***
+          !*** for consistency, we must make sure all lons are in
+          !*** same 2pi interval
+          !***
+
+          vec1_lon = src_lons(1) - plon
+          if (vec1_lon >  pi) then
+            src_lons(1) = src_lons(1) - pi2
+          else if (vec1_lon < -pi) then
+            src_lons(1) = src_lons(1) + pi2
+          endif
+          do n=2,4
+            vec1_lon = src_lons(n) - src_lons(1)
+            if (vec1_lon >  pi) then
+              src_lons(n) = src_lons(n) - pi2
+            else if (vec1_lon < -pi) then
+              src_lons(n) = src_lons(n) + pi2
+            endif
+          end do
+
+          corner_loop: do n=1,4
+            next_n = MOD(n,4) + 1
+
+            !***
+            !*** here we take the cross product of the vector making 
+            !*** up each box side with the vector formed by the vertex
+            !*** and search point.  if all the cross products are 
+            !*** positive, the point is contained in the box.
+            !***
+
+            vec1_lat = src_lats(next_n) - src_lats(n)
+            vec1_lon = src_lons(next_n) - src_lons(n)
+            vec2_lat = plat - src_lats(n)
+            vec2_lon = plon - src_lons(n)
+
+            !***
+            !*** check for 0,2pi crossings
+            !***
+
+            if (vec1_lon >  three*pih) then
+              vec1_lon = vec1_lon - pi2
+            else if (vec1_lon < -three*pih) then
+              vec1_lon = vec1_lon + pi2
+            endif
+            if (vec2_lon >  three*pih) then
+              vec2_lon = vec2_lon - pi2
+            else if (vec2_lon < -three*pih) then
+              vec2_lon = vec2_lon + pi2
+            endif
+
+            cross_product = vec1_lon*vec2_lat - vec2_lon*vec1_lat
+
+            !***
+            !*** if cross product is less than zero, this cell
+            !*** doesn't work
+            !***
+
+            if (n == 1) cross_product_last = cross_product
+            if (cross_product*cross_product_last < zero)  &
+                exit corner_loop
+            cross_product_last = cross_product
+
+          end do corner_loop
+
+          !***
+          !*** if cross products all same sign, we found the location
+          !***
+
+          if (n > 4) then
+            src_add(1) = srch_add
+            src_add(2) = e_add
+            src_add(3) = ne_add
+            src_add(4) = n_add
+
+            return
+          endif
+
+          !***
+          !*** otherwise move on to next cell
+          !***
+
+        endif !bounding box check
+      end do srch_loop
+
+      !***
+      !*** if no cell found, point is likely either in a box that
+      !*** straddles either pole or is outside the grid.  fall back
+      !*** to a distance-weighted average of the four closest
+      !*** points.  go ahead and compute weights here, but store
+      !*** in src_lats and return -add to prevent the parent
+      !*** routine from computing bilinear weights
+      !***
+
+      !print *,'Could not find location for ',plat,plon
+      !print *,'Using nearest-neighbor average for this point'
+
+      coslat_dst = cos(plat)
+      sinlat_dst = sin(plat)
+      coslon_dst = cos(plon)
+      sinlon_dst = sin(plon)
+
+      dist_min = bignum
+      src_lats = bignum
+      do srch_add = min_add,max_add
+        distance = acos(coslat_dst*cos(src_center_lat(srch_add))* &
+                       (coslon_dst*cos(src_center_lon(srch_add)) + &
+                        sinlon_dst*sin(src_center_lon(srch_add)))+ &
+                        sinlat_dst*sin(src_center_lat(srch_add)))
+
+        if (distance < dist_min) then
+          sort_loop: do n=1,4
+            if (distance < src_lats(n)) then
+              do i=4,n+1,-1
+                src_add (i) = src_add (i-1)
+                src_lats(i) = src_lats(i-1)
+              end do
+              src_add (n) = -srch_add
+              src_lats(n) = distance
+              dist_min = src_lats(4)
+              exit sort_loop
+            endif
+          end do sort_loop
+        endif
+      end do
+
+      src_lons = one/(src_lats + tiny)
+      distance = sum(src_lons)
+      src_lats = src_lons/distance
+
+!-----------------------------------------------------------------------
+
+      end subroutine grid_search_bilin 
+
+!***********************************************************************
+
+      subroutine store_link_bilin(dst_add, src_add, weights, nmap)
+
+!-----------------------------------------------------------------------
+!
+!     this routine stores the address and weight for four links 
+!     associated with one destination point in the appropriate address 
+!     and weight arrays and resizes those arrays if necessary.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) :: &
+              dst_add,   & ! address on destination grid
+              nmap      ! identifies which direction for mapping
+
+      integer (kind=int_kind), dimension(4), intent(in) :: &
+              src_add   ! addresses on source grid
+
+      real (kind=dbl_kind), dimension(4), intent(in) :: &
+              weights ! array of remapping weights for these links
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n,  & ! dummy index
+             num_links_old          ! placeholder for old link number
+
+!-----------------------------------------------------------------------
+!
+!     increment number of links and check to see if remap arrays need
+!     to be increased to accomodate the new link.  then store the
+!     link.
+!
+!-----------------------------------------------------------------------
+
+      select case (nmap)
+      case(1)
+
+        num_links_old  = num_links_map1
+        num_links_map1 = num_links_old + 4
+
+        if (num_links_map1 > max_links_map1)  &
+           call resize_remap_vars(1,resize_increment)
+
+        do n=1,4
+          grid1_add_map1(num_links_old+n) = src_add(n)
+          grid2_add_map1(num_links_old+n) = dst_add
+          wts_map1    (1,num_links_old+n) = weights(n)
+        end do
+
+      case(2)
+
+        num_links_old  = num_links_map2
+        num_links_map2 = num_links_old + 4
+
+        if (num_links_map2 > max_links_map2)  &
+           call resize_remap_vars(2,resize_increment)
+
+        do n=1,4
+          grid1_add_map2(num_links_old+n) = dst_add
+          grid2_add_map2(num_links_old+n) = src_add(n)
+          wts_map2    (1,num_links_old+n) = weights(n)
+        end do
+
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine store_link_bilin
+
+!***********************************************************************
+
+      end module remap_bilinear
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/remap_conserv.f90
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/remap_conserv.f90	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/remap_conserv.f90	(revision 2352)
@@ -0,0 +1,2197 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary routines for computing addresses
+!     and weights for a conservative interpolation  between any two 
+!     grids on a sphere.  the weights are computed by performing line 
+!     integrals around all overlap regions of the two grids.  see 
+!     Dukowicz and Kodis, SIAM J. Sci. Stat. Comput. 8, 305 (1987) and
+!     Jones, P.W. Monthly Weather Review (submitted).
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_conserv.f,v 1.10 2001/08/21 21:05:13 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_conservative
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod    ! defines common data types
+      use constants    ! defines common constants
+      use timers       ! module for timing
+      use grids        ! module containing grid information
+      use remap_vars   ! module containing remap information
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), save ::  &
+              num_srch_cells ! num cells in restricted search arrays
+
+      integer (kind=int_kind), dimension(:), allocatable, save ::  &
+              srch_add       ! global address of cells in srch arrays
+
+      real (kind=dbl_kind), parameter ::  &
+           north_thresh = 1.45_dbl_kind,  & ! threshold for coord transf.
+           south_thresh =-2.00_dbl_kind  ! threshold for coord transf.
+
+      real (kind=dbl_kind), dimension(:,:), allocatable, save :: &
+           srch_corner_lat,   & ! lat of each corner of srch cells
+           srch_corner_lon   ! lon of each corner of srch cells
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap_conserv
+
+!-----------------------------------------------------------------------
+!
+!     this routine traces the perimeters of every grid cell on each
+!     grid checking for intersections with the other grid and computing
+!     line integrals for each subsegment.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter ::  &
+              max_subseg = 10000 ! max number of subsegments per segment
+                                 ! to prevent infinite loop
+
+      integer (kind=int_kind) ::  &
+              grid1_add,   & ! current linear address for grid1 cell
+              grid2_add,   & ! current linear address for grid2 cell
+              min_add,     & ! addresses for restricting search of
+              max_add,     & !   destination grid
+              n, nwgt,     & ! generic counters
+              corner,      & ! corner of cell that segment starts from
+              next_corn,   & ! corner of cell that segment ends on
+              num_subseg  ! number of subsegments 
+
+      logical (kind=log_kind) ::  &
+              lcoinc,   & ! flag for coincident segments
+              lrevers,  & ! flag for reversing direction of segment
+              lbegin   ! flag for first integration of a segment
+
+      logical (kind=log_kind), dimension(:), allocatable :: &
+              srch_mask   ! mask for restricting searches
+
+      real (kind=dbl_kind) :: &
+           intrsct_lat, intrsct_lon,        & ! lat/lon of next intersect
+           beglat, endlat, beglon, endlon,  & ! endpoints of current seg.
+           norm_factor                     ! factor for normalizing wts
+
+      real (kind=dbl_kind), dimension(:), allocatable :: &
+             grid2_centroid_lat, grid2_centroid_lon,  & ! centroid coords
+             grid1_centroid_lat, grid1_centroid_lon  ! on each grid
+
+      real (kind=dbl_kind), dimension(2) :: begseg ! begin lat/lon for
+                                                   ! full segment
+
+      real (kind=dbl_kind), dimension(6) :: weights ! local wgt array
+
+!-----------------------------------------------------------------------
+!
+!     initialize centroid arrays
+!
+!-----------------------------------------------------------------------
+
+      allocate( grid1_centroid_lat(grid1_size), &
+                grid1_centroid_lon(grid1_size), &
+                grid2_centroid_lat(grid2_size), &
+                grid2_centroid_lon(grid2_size))
+
+      grid1_centroid_lat = zero
+      grid1_centroid_lon = zero
+      grid2_centroid_lat = zero
+      grid2_centroid_lon = zero
+
+!-----------------------------------------------------------------------
+!
+!     integrate around each cell on grid1
+!
+!-----------------------------------------------------------------------
+
+      allocate(srch_mask(grid2_size))
+
+      print *,'grid1 sweep '
+      do grid1_add = 1,grid1_size
+
+        !***
+        !*** restrict searches first using search bins
+        !***
+
+        call timer_start(1)
+        min_add = grid2_size
+        max_add = 1
+        do n=1,num_srch_bins
+          if (grid1_add >= bin_addr1(1,n) .and. &
+              grid1_add <= bin_addr1(2,n)) then
+            min_add = min(min_add, bin_addr2(1,n))
+            max_add = max(max_add, bin_addr2(2,n))
+          endif
+        end do
+
+        !***
+        !*** further restrict searches using bounding boxes
+        !***
+
+        num_srch_cells = 0
+        do grid2_add = min_add,max_add
+          srch_mask(grid2_add) = (grid2_bound_box(1,grid2_add) <=  &
+                                  grid1_bound_box(2,grid1_add)) .and. &
+                                 (grid2_bound_box(2,grid2_add) >=  &
+                                  grid1_bound_box(1,grid1_add)) .and. &
+                                 (grid2_bound_box(3,grid2_add) <=  &
+                                  grid1_bound_box(4,grid1_add)) .and. &
+                                 (grid2_bound_box(4,grid2_add) >=  &
+                                  grid1_bound_box(3,grid1_add))
+
+          if (srch_mask(grid2_add)) num_srch_cells = num_srch_cells+1
+        end do
+
+        !***
+        !*** create search arrays
+        !***
+
+        allocate(srch_add(num_srch_cells), &
+                 srch_corner_lat(grid2_corners,num_srch_cells), &
+                 srch_corner_lon(grid2_corners,num_srch_cells))
+
+        n = 0
+        gather1: do grid2_add = min_add,max_add
+          if (srch_mask(grid2_add)) then
+            n = n+1
+            srch_add(n) = grid2_add
+            srch_corner_lat(:,n) = grid2_corner_lat(:,grid2_add)
+            srch_corner_lon(:,n) = grid2_corner_lon(:,grid2_add)
+          endif
+        end do gather1
+        call timer_stop(1)
+
+        !***
+        !*** integrate around this cell
+        !***
+
+        do corner = 1,grid1_corners
+          next_corn = mod(corner,grid1_corners) + 1
+
+          !***
+          !*** define endpoints of the current segment
+          !***
+
+          beglat = grid1_corner_lat(corner,grid1_add)
+          beglon = grid1_corner_lon(corner,grid1_add)
+          endlat = grid1_corner_lat(next_corn,grid1_add)
+          endlon = grid1_corner_lon(next_corn,grid1_add)
+          lrevers = .false.
+
+          !***
+          !*** to ensure exact path taken during both
+          !*** sweeps, always integrate segments in the same 
+          !*** direction (SW to NE).
+          !***
+
+          if ((endlat < beglat) .or. &
+              (endlat == beglat .and. endlon < beglon)) then 
+            beglat = grid1_corner_lat(next_corn,grid1_add)
+            beglon = grid1_corner_lon(next_corn,grid1_add)
+            endlat = grid1_corner_lat(corner,grid1_add)
+            endlon = grid1_corner_lon(corner,grid1_add)
+            lrevers = .true.
+          endif
+
+          begseg(1) = beglat
+          begseg(2) = beglon
+          lbegin = .true.
+          num_subseg = 0
+
+          !***
+          !*** if this is a constant-longitude segment, skip the rest 
+          !*** since the line integral contribution will be zero.
+          !***
+
+          if (endlon /= beglon) then
+
+          !***
+          !*** integrate along this segment, detecting intersections 
+          !*** and computing the line integral for each sub-segment
+          !***
+
+          do while (beglat /= endlat .or. beglon /= endlon)
+
+            !***
+            !*** prevent infinite loops if integration gets stuck
+            !*** near cell or threshold boundary
+            !***
+
+            num_subseg = num_subseg + 1
+            if (num_subseg > max_subseg) then
+              stop 'integration stalled: num_subseg exceeded limit'
+            endif
+
+            !***
+            !*** find next intersection of this segment with a grid
+            !*** line on grid 2.
+            !***
+
+            call timer_start(2)
+            call intersection(grid2_add,intrsct_lat,intrsct_lon,lcoinc, &
+                              beglat, beglon, endlat, endlon, begseg,  &
+                              lbegin, lrevers)
+            call timer_stop(2)
+            lbegin = .false.
+
+            !***
+            !*** compute line integral for this subsegment.
+            !***
+
+            call timer_start(3)
+            if (grid2_add /= 0) then
+              call line_integral(weights, num_wts, &
+                               beglon, intrsct_lon, beglat, intrsct_lat, &
+                               grid1_center_lat(grid1_add),  &
+                               grid1_center_lon(grid1_add), &
+                               grid2_center_lat(grid2_add),  &
+                               grid2_center_lon(grid2_add))
+            else
+              call line_integral(weights, num_wts, &
+                               beglon, intrsct_lon, beglat, intrsct_lat, &
+                               grid1_center_lat(grid1_add),  &
+                               grid1_center_lon(grid1_add), &
+                               grid1_center_lat(grid1_add),  &
+                               grid1_center_lon(grid1_add))
+            endif
+            call timer_stop(3)
+
+            !***
+            !*** if integrating in reverse order, change
+            !*** sign of weights
+            !***
+
+            if (lrevers) then
+              weights = -weights
+            endif
+
+            !***
+            !*** store the appropriate addresses and weights. 
+            !*** also add contributions to cell areas and centroids.
+            !***
+
+            !if (grid1_add == 119247) then
+            !  print *,grid1_add,grid2_add,corner,weights(1)
+            !  print *,grid1_corner_lat(:,grid1_add)
+            !  print *,grid1_corner_lon(:,grid1_add)
+            !  print *,grid2_corner_lat(:,grid2_add)
+            !  print *,grid2_corner_lon(:,grid2_add)
+            !  print *,beglat,beglon,intrsct_lat,intrsct_lon
+            !endif
+
+            if (grid2_add /= 0) then
+              if (grid1_mask(grid1_add)) then
+                call timer_start(4)
+                call store_link_cnsrv(grid1_add, grid2_add, weights)
+                call timer_stop(4)
+                grid1_frac(grid1_add) = grid1_frac(grid1_add) +  &
+                                        weights(1)
+                grid2_frac(grid2_add) = grid2_frac(grid2_add) +  &
+                                        weights(num_wts+1)
+              endif
+
+            endif
+
+            grid1_area(grid1_add) = grid1_area(grid1_add) + weights(1)
+            grid1_centroid_lat(grid1_add) =  &
+            grid1_centroid_lat(grid1_add) + weights(2)
+            grid1_centroid_lon(grid1_add) =  &
+            grid1_centroid_lon(grid1_add) + weights(3)
+
+            !***
+            !*** reset beglat and beglon for next subsegment.
+            !***
+
+            beglat = intrsct_lat
+            beglon = intrsct_lon
+          end do
+
+          endif
+
+          !***
+          !*** end of segment
+          !***
+
+        end do
+
+        !***
+        !*** finished with this cell: deallocate search array and
+        !*** start on next cell
+
+        deallocate(srch_add, srch_corner_lat, srch_corner_lon)
+
+      end do
+
+      deallocate(srch_mask)
+
+!-----------------------------------------------------------------------
+!
+!     integrate around each cell on grid2
+!
+!-----------------------------------------------------------------------
+
+      allocate(srch_mask(grid1_size))
+
+      print *,'grid2 sweep '
+      do grid2_add = 1,grid2_size
+
+        !***
+        !*** restrict searches first using search bins
+        !***
+
+        call timer_start(5)
+        min_add = grid1_size
+        max_add = 1
+        do n=1,num_srch_bins
+          if (grid2_add >= bin_addr2(1,n) .and. &
+              grid2_add <= bin_addr2(2,n)) then
+            min_add = min(min_add, bin_addr1(1,n))
+            max_add = max(max_add, bin_addr1(2,n))
+          endif
+        end do
+
+        !***
+        !*** further restrict searches using bounding boxes
+        !***
+
+        num_srch_cells = 0
+        do grid1_add = min_add, max_add
+          srch_mask(grid1_add) = (grid1_bound_box(1,grid1_add) <=  &
+                                  grid2_bound_box(2,grid2_add)) .and. &
+                                 (grid1_bound_box(2,grid1_add) >=  &
+                                  grid2_bound_box(1,grid2_add)) .and. &
+                                 (grid1_bound_box(3,grid1_add) <=  &
+                                  grid2_bound_box(4,grid2_add)) .and. &
+                                 (grid1_bound_box(4,grid1_add) >=  &
+                                  grid2_bound_box(3,grid2_add))
+
+          if (srch_mask(grid1_add)) num_srch_cells = num_srch_cells+1
+        end do
+
+        allocate(srch_add(num_srch_cells), &
+                 srch_corner_lat(grid1_corners,num_srch_cells), &
+                 srch_corner_lon(grid1_corners,num_srch_cells))
+
+        n = 0
+        gather2: do grid1_add = min_add,max_add
+          if (srch_mask(grid1_add)) then
+            n = n+1
+            srch_add(n) = grid1_add
+            srch_corner_lat(:,n) = grid1_corner_lat(:,grid1_add)
+            srch_corner_lon(:,n) = grid1_corner_lon(:,grid1_add)
+          endif
+        end do gather2
+        call timer_stop(5)
+
+        !***
+        !*** integrate around this cell
+        !***
+
+        do corner = 1,grid2_corners
+          next_corn = mod(corner,grid2_corners) + 1
+
+          beglat = grid2_corner_lat(corner,grid2_add)
+          beglon = grid2_corner_lon(corner,grid2_add)
+          endlat = grid2_corner_lat(next_corn,grid2_add)
+          endlon = grid2_corner_lon(next_corn,grid2_add)
+          lrevers = .false.
+
+          !***
+          !*** to ensure exact path taken during both
+          !*** sweeps, always integrate in the same direction
+          !***
+
+          if ((endlat < beglat) .or. &
+              (endlat == beglat .and. endlon < beglon)) then 
+            beglat = grid2_corner_lat(next_corn,grid2_add)
+            beglon = grid2_corner_lon(next_corn,grid2_add)
+            endlat = grid2_corner_lat(corner,grid2_add)
+            endlon = grid2_corner_lon(corner,grid2_add)
+            lrevers = .true.
+          endif
+
+          begseg(1) = beglat
+          begseg(2) = beglon
+          lbegin = .true.
+
+          !***
+          !*** if this is a constant-longitude segment, skip the rest 
+          !*** since the line integral contribution will be zero.
+          !***
+
+          if (endlon /= beglon) then
+          num_subseg = 0
+
+          !***
+          !*** integrate along this segment, detecting intersections 
+          !*** and computing the line integral for each sub-segment
+          !***
+
+          do while (beglat /= endlat .or. beglon /= endlon)
+
+            !***
+            !*** prevent infinite loops if integration gets stuck
+            !*** near cell or threshold boundary
+            !***
+
+            num_subseg = num_subseg + 1
+            if (num_subseg > max_subseg) then
+              stop 'integration stalled: num_subseg exceeded limit'
+            endif
+
+            !***
+            !*** find next intersection of this segment with a line 
+            !*** on grid 2.
+            !***
+
+            call timer_start(6)
+            call intersection(grid1_add,intrsct_lat,intrsct_lon,lcoinc, &
+                              beglat, beglon, endlat, endlon, begseg, &
+                              lbegin, lrevers)
+            call timer_stop(6)
+            lbegin = .false.
+
+            !***
+            !*** compute line integral for this subsegment.
+            !***
+
+            call timer_start(7)
+            if (grid1_add /= 0) then
+              call line_integral(weights, num_wts, &
+                               beglon, intrsct_lon, beglat, intrsct_lat, &
+                               grid1_center_lat(grid1_add),  &
+                               grid1_center_lon(grid1_add), &
+                               grid2_center_lat(grid2_add),  &
+                               grid2_center_lon(grid2_add))
+            else
+              call line_integral(weights, num_wts, &
+                               beglon, intrsct_lon, beglat, intrsct_lat, &
+                               grid2_center_lat(grid2_add),  &
+                               grid2_center_lon(grid2_add), &
+                               grid2_center_lat(grid2_add),  &
+                               grid2_center_lon(grid2_add))
+            endif
+            call timer_stop(7)
+
+            if (lrevers) then
+              weights = -weights
+            endif
+
+            !***
+            !*** store the appropriate addresses and weights. 
+            !*** also add contributions to cell areas and centroids.
+            !*** if there is a coincidence, do not store weights
+            !*** because they have been captured in the previous loop.
+            !*** the grid1 mask is the master mask
+            !***
+
+            !if (grid1_add == 119247) then
+            !  print *,grid1_add,grid2_add,corner,weights(1)
+            !  print *,grid1_corner_lat(:,grid1_add)
+            !  print *,grid1_corner_lon(:,grid1_add)
+            !  print *,grid2_corner_lat(:,grid2_add)
+            !  print *,grid2_corner_lon(:,grid2_add)
+            !  print *,beglat,beglon,intrsct_lat,intrsct_lon
+            !endif
+
+            if (.not. lcoinc .and. grid1_add /= 0) then
+              if (grid1_mask(grid1_add)) then
+                call timer_start(8)
+                call store_link_cnsrv(grid1_add, grid2_add, weights)
+                call timer_stop(8)
+                grid1_frac(grid1_add) = grid1_frac(grid1_add) +  &
+                                        weights(1)
+                grid2_frac(grid2_add) = grid2_frac(grid2_add) +  &
+                                        weights(num_wts+1)
+              endif
+
+            endif
+
+            grid2_area(grid2_add) = grid2_area(grid2_add) +  &
+                                            weights(num_wts+1)
+            grid2_centroid_lat(grid2_add) =  &
+            grid2_centroid_lat(grid2_add) + weights(num_wts+2)
+            grid2_centroid_lon(grid2_add) =  &
+            grid2_centroid_lon(grid2_add) + weights(num_wts+3)
+
+            !***
+            !*** reset beglat and beglon for next subsegment.
+            !***
+
+            beglat = intrsct_lat
+            beglon = intrsct_lon
+          end do
+
+          endif
+
+          !***
+          !*** end of segment
+          !***
+
+        end do
+
+        !***
+        !*** finished with this cell: deallocate search array and
+        !*** start on next cell
+
+        deallocate(srch_add, srch_corner_lat, srch_corner_lon)
+
+      end do
+
+      deallocate(srch_mask)
+
+!-----------------------------------------------------------------------
+!
+!     correct for situations where N/S pole not explicitly included in
+!     grid (i.e. as a grid corner point). if pole is missing from only
+!     one grid, need to correct only the area and centroid of that 
+!     grid.  if missing from both, do complete weight calculation.
+!
+!-----------------------------------------------------------------------
+
+      !*** North Pole
+      weights(1) =  pi2
+      weights(2) =  pi*pi
+      weights(3) =  zero
+      weights(4) =  pi2
+      weights(5) =  pi*pi
+      weights(6) =  zero
+
+      grid1_add = 0
+      pole_loop1: do n=1,grid1_size
+        if (grid1_area(n) < -three*pih .and. &
+            grid1_center_lat(n) > zero) then
+          grid1_add = n
+          exit pole_loop1
+        endif
+      end do pole_loop1
+
+      grid2_add = 0
+      pole_loop2: do n=1,grid2_size
+        if (grid2_area(n) < -three*pih .and. &
+            grid2_center_lat(n) > zero) then
+          grid2_add = n
+          exit pole_loop2
+        endif
+      end do pole_loop2
+
+      if (grid1_add /=0) then
+        grid1_area(grid1_add) = grid1_area(grid1_add) + weights(1)
+        grid1_centroid_lat(grid1_add) =  &
+        grid1_centroid_lat(grid1_add) + weights(2)
+        grid1_centroid_lon(grid1_add) = &
+        grid1_centroid_lon(grid1_add) + weights(3)
+      endif
+
+      if (grid2_add /=0) then
+        grid2_area(grid2_add) = grid2_area(grid2_add) +  &
+                                        weights(num_wts+1)
+        grid2_centroid_lat(grid2_add) =  &
+        grid2_centroid_lat(grid2_add) + weights(num_wts+2)
+        grid2_centroid_lon(grid2_add) = &
+        grid2_centroid_lon(grid2_add) + weights(num_wts+3)
+      endif
+
+      if (grid1_add /= 0 .and. grid2_add /=0) then
+        call store_link_cnsrv(grid1_add, grid2_add, weights)
+
+        grid1_frac(grid1_add) = grid1_frac(grid1_add) +  &
+                                weights(1)
+        grid2_frac(grid2_add) = grid2_frac(grid2_add) +  &
+                                weights(num_wts+1)
+      endif
+
+      !*** South Pole
+      weights(1) =  pi2
+      weights(2) = -pi*pi
+      weights(3) =  zero
+      weights(4) =  pi2
+      weights(5) = -pi*pi
+      weights(6) =  zero
+
+      grid1_add = 0
+      pole_loop3: do n=1,grid1_size
+        if (grid1_area(n) < -three*pih .and. &
+            grid1_center_lat(n) < zero) then
+          grid1_add = n
+          exit pole_loop3
+        endif
+      end do pole_loop3
+
+      grid2_add = 0
+      pole_loop4: do n=1,grid2_size
+        if (grid2_area(n) < -three*pih .and. &
+            grid2_center_lat(n) < zero) then
+          grid2_add = n
+          exit pole_loop4
+        endif
+      end do pole_loop4
+
+      if (grid1_add /=0) then
+        grid1_area(grid1_add) = grid1_area(grid1_add) + weights(1)
+        grid1_centroid_lat(grid1_add) =  &
+        grid1_centroid_lat(grid1_add) + weights(2)
+        grid1_centroid_lon(grid1_add) = &
+        grid1_centroid_lon(grid1_add) + weights(3)
+      endif
+
+      if (grid2_add /=0) then
+        grid2_area(grid2_add) = grid2_area(grid2_add) +  &
+                                        weights(num_wts+1)
+        grid2_centroid_lat(grid2_add) =  &
+        grid2_centroid_lat(grid2_add) + weights(num_wts+2)
+        grid2_centroid_lon(grid2_add) = &
+        grid2_centroid_lon(grid2_add) + weights(num_wts+3)
+      endif
+
+      if (grid1_add /= 0 .and. grid2_add /=0) then
+        call store_link_cnsrv(grid1_add, grid2_add, weights)
+
+        grid1_frac(grid1_add) = grid1_frac(grid1_add) +  &
+                                weights(1)
+        grid2_frac(grid2_add) = grid2_frac(grid2_add) +  &
+                                weights(num_wts+1)
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     finish centroid computation
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_area /= zero)
+        grid1_centroid_lat = grid1_centroid_lat/grid1_area
+        grid1_centroid_lon = grid1_centroid_lon/grid1_area
+      end where
+
+      where (grid2_area /= zero)
+        grid2_centroid_lat = grid2_centroid_lat/grid2_area
+        grid2_centroid_lon = grid2_centroid_lon/grid2_area
+      end where
+
+!-----------------------------------------------------------------------
+!
+!     include centroids in weights and normalize using destination
+!     area if requested
+!
+!-----------------------------------------------------------------------
+
+      do n=1,num_links_map1
+        grid1_add = grid1_add_map1(n)
+        grid2_add = grid2_add_map1(n)
+        do nwgt=1,num_wts
+          weights(        nwgt) = wts_map1(nwgt,n)
+          if (num_maps > 1) then
+            weights(num_wts+nwgt) = wts_map2(nwgt,n)
+          endif
+        end do
+
+        select case(norm_opt)
+        case (norm_opt_dstarea)
+          if (grid2_area(grid2_add) /= zero) then
+            if (luse_grid2_area) then
+              norm_factor = one/grid2_area_in(grid2_add)
+            else
+              norm_factor = one/grid2_area(grid2_add)
+            endif
+          else
+            norm_factor = zero
+          endif
+        case (norm_opt_frcarea)
+          if (grid2_frac(grid2_add) /= zero) then
+            if (luse_grid2_area) then
+              norm_factor = grid2_area(grid2_add)/ &
+                           (grid2_frac(grid2_add)* &
+                            grid2_area_in(grid2_add))
+            else
+              norm_factor = one/grid2_frac(grid2_add)
+            endif
+          else
+            norm_factor = zero
+          endif
+        case (norm_opt_none)
+          norm_factor = one
+        end select
+
+        wts_map1(1,n) =  weights(1)*norm_factor
+        wts_map1(2,n) = (weights(2) - weights(1)* &
+                                    grid1_centroid_lat(grid1_add))* &
+                                    norm_factor
+        wts_map1(3,n) = (weights(3) - weights(1)* &
+                                    grid1_centroid_lon(grid1_add))* &
+                                    norm_factor
+
+        if (num_maps > 1) then
+          select case(norm_opt)
+          case (norm_opt_dstarea)
+            if (grid1_area(grid1_add) /= zero) then
+              if (luse_grid1_area) then
+                norm_factor = one/grid1_area_in(grid1_add)
+              else
+                norm_factor = one/grid1_area(grid1_add)
+              endif
+            else
+              norm_factor = zero
+            endif
+          case (norm_opt_frcarea)
+            if (grid1_frac(grid1_add) /= zero) then
+              if (luse_grid1_area) then
+                norm_factor = grid1_area(grid1_add)/ &
+                             (grid1_frac(grid1_add)* &
+                              grid1_area_in(grid1_add))
+              else
+                norm_factor = one/grid1_frac(grid1_add)
+              endif
+            else
+              norm_factor = zero
+            endif
+          case (norm_opt_none)
+            norm_factor = one
+          end select
+
+          wts_map2(1,n) =  weights(num_wts+1)*norm_factor
+          wts_map2(2,n) = (weights(num_wts+2) - weights(num_wts+1)* &
+                                      grid2_centroid_lat(grid2_add))* &
+                                      norm_factor
+          wts_map2(3,n) = (weights(num_wts+3) - weights(num_wts+1)* &
+                                      grid2_centroid_lon(grid2_add))* &
+                                      norm_factor
+        endif
+
+      end do
+
+      print *, 'Total number of links = ',num_links_map1
+
+      where (grid1_area /= zero) grid1_frac = grid1_frac/grid1_area
+      where (grid2_area /= zero) grid2_frac = grid2_frac/grid2_area
+
+!-----------------------------------------------------------------------
+!
+!     perform some error checking on final weights
+!
+!-----------------------------------------------------------------------
+
+      grid2_centroid_lat = zero
+      grid2_centroid_lon = zero
+
+      do n=1,grid1_size
+        if (grid1_area(n) < -.01) then
+          print *,'Grid 1 area error: ',n,grid1_area(n)
+        endif
+        if (grid1_centroid_lat(n) < -pih-.01 .or. &
+            grid1_centroid_lat(n) >  pih+.01) then
+          print *,'Grid 1 centroid lat error: ',n,grid1_centroid_lat(n)
+        endif
+        grid1_centroid_lat(n) = zero
+        grid1_centroid_lon(n) = zero
+      end do
+
+      do n=1,grid2_size
+        if (grid2_area(n) < -.01) then
+          print *,'Grid 2 area error: ',n,grid2_area(n)
+        endif
+        if (grid2_centroid_lat(n) < -pih-.01 .or. &
+            grid2_centroid_lat(n) >  pih+.01) then
+          print *,'Grid 2 centroid lat error: ',n,grid2_centroid_lat(n)
+        endif
+        grid2_centroid_lat(n) = zero
+        grid2_centroid_lon(n) = zero
+      end do
+
+      do n=1,num_links_map1
+        grid1_add = grid1_add_map1(n)
+        grid2_add = grid2_add_map1(n)
+        
+        if (wts_map1(1,n) < -.01) then
+          print *,'Map 1 weight < 0 ',grid1_add,grid2_add,wts_map1(1,n)
+        endif
+        if (norm_opt /= norm_opt_none .and. wts_map1(1,n) > 1.01) then
+          print *,'Map 1 weight > 1 ',grid1_add,grid2_add,wts_map1(1,n)
+        endif
+        grid2_centroid_lat(grid2_add) =  &
+        grid2_centroid_lat(grid2_add) + wts_map1(1,n)
+
+        if (num_maps > 1) then
+          if (wts_map2(1,n) < -.01) then
+            print *,'Map 2 weight < 0 ',grid1_add,grid2_add, &
+                                        wts_map2(1,n)
+          endif
+          if (norm_opt /= norm_opt_none .and. wts_map2(1,n) > 1.01) then
+            print *,'Map 2 weight < 0 ',grid1_add,grid2_add, &
+                                        wts_map2(1,n)
+          endif
+          grid1_centroid_lat(grid1_add) =  &
+          grid1_centroid_lat(grid1_add) + wts_map2(1,n)
+        endif
+      end do
+
+      do n=1,grid2_size
+        select case(norm_opt)
+        case (norm_opt_dstarea)
+          norm_factor = grid2_frac(grid2_add)
+        case (norm_opt_frcarea)
+          norm_factor = one
+        case (norm_opt_none)
+          if (luse_grid2_area) then
+            norm_factor = grid2_area_in(grid2_add)
+          else
+            norm_factor = grid2_area(grid2_add)
+          endif
+        end select
+        if (abs(grid2_centroid_lat(grid2_add)-norm_factor) > .01) then
+          print *,'Error: sum of wts for map1 ',grid2_add, &
+                  grid2_centroid_lat(grid2_add),norm_factor
+        endif
+      end do
+
+      if (num_maps > 1) then
+        do n=1,grid1_size
+          select case(norm_opt)
+          case (norm_opt_dstarea)
+            norm_factor = grid1_frac(grid1_add)
+          case (norm_opt_frcarea)
+            norm_factor = one
+          case (norm_opt_none)
+            if (luse_grid1_area) then
+              norm_factor = grid1_area_in(grid1_add)
+            else
+              norm_factor = grid1_area(grid1_add)
+            endif
+          end select
+          if (abs(grid1_centroid_lat(grid1_add)-norm_factor) > .01) then
+            print *,'Error: sum of wts for map2 ',grid1_add, &
+                    grid1_centroid_lat(grid1_add),norm_factor
+          endif
+        end do
+      endif
+!-----------------------------------------------------------------------
+
+      end subroutine remap_conserv
+
+!***********************************************************************
+
+      subroutine intersection(location,intrsct_lat,intrsct_lon,lcoinc, &
+                              beglat, beglon, endlat, endlon, begseg, &
+                              lbegin, lrevers)
+
+!-----------------------------------------------------------------------
+!
+!     this routine finds the next intersection of a destination grid 
+!     line with the line segment given by beglon, endlon, etc.
+!     a coincidence flag is returned if the segment is entirely 
+!     coincident with an ocean grid line.  the cells in which to search
+!     for an intersection must have already been restricted in the
+!     calling routine.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     intent(in): 
+!
+!-----------------------------------------------------------------------
+
+      logical (kind=log_kind), intent(in) :: &
+           lbegin,  & ! flag for first integration along this segment
+           lrevers ! flag whether segment integrated in reverse
+
+      real (kind=dbl_kind), intent(in) ::  &
+           beglat, beglon,   & ! beginning lat/lon endpoints for segment
+           endlat, endlon   ! ending    lat/lon endpoints for segment
+
+      real (kind=dbl_kind), dimension(2), intent(inout) ::  &
+           begseg ! begin lat/lon of full segment
+
+!-----------------------------------------------------------------------
+!
+!     intent(out): 
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(out) :: &
+              location  ! address in destination array containing this
+                        ! segment
+
+      logical (kind=log_kind), intent(out) :: &
+              lcoinc    ! flag segments which are entirely coincident
+                        ! with a grid line
+
+      real (kind=dbl_kind), intent(out) :: &
+           intrsct_lat, intrsct_lon ! lat/lon coords of next intersect.
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, next_n, cell, srch_corners, pole_loc
+
+      integer (kind=int_kind), save ::  &
+           last_loc  ! save location when crossing threshold
+
+      logical (kind=log_kind) ::  &
+           loutside  ! flags points outside grid
+
+      logical (kind=log_kind), save ::  &
+           lthresh = .false.  ! flags segments crossing threshold bndy
+
+      real (kind=dbl_kind) :: &
+           lon1, lon2,        & ! local longitude variables for segment
+           lat1, lat2,        & ! local latitude  variables for segment
+           grdlon1, grdlon2,  & ! local longitude variables for grid cell
+           grdlat1, grdlat2,  & ! local latitude  variables for grid cell
+           vec1_lat, vec1_lon,  & ! vectors and cross products used
+           vec2_lat, vec2_lon,  & ! during grid search
+           cross_product,  &
+           eps, offset,         & ! small offset away from intersect
+           s1, s2, determ,      & ! variables used for linear solve to
+           mat1, mat2, mat3, mat4, rhs1, rhs2  ! find intersection
+
+      real (kind=dbl_kind), save :: &
+           intrsct_lat_off, intrsct_lon_off ! lat/lon coords offset 
+                                            ! for next search
+
+!-----------------------------------------------------------------------
+!
+!     initialize defaults, flags, etc.
+!
+!-----------------------------------------------------------------------
+
+      location = 0
+      lcoinc = .false.
+      intrsct_lat = endlat
+      intrsct_lon = endlon
+
+      if (num_srch_cells == 0) return
+
+      if (beglat > north_thresh .or. beglat < south_thresh) then
+
+        if (lthresh) location = last_loc
+        call pole_intersection(location, &
+                     intrsct_lat,intrsct_lon,lcoinc,lthresh, &
+                     beglat, beglon, endlat, endlon, begseg, lrevers)
+        if (lthresh) then
+          last_loc = location
+          intrsct_lat_off = intrsct_lat
+          intrsct_lon_off = intrsct_lon
+        endif
+        return
+
+      endif
+
+      loutside = .false.
+      if (lbegin) then
+        lat1 = beglat
+        lon1 = beglon
+      else
+        lat1 = intrsct_lat_off
+        lon1 = intrsct_lon_off
+      endif
+      lat2 = endlat
+      lon2 = endlon
+      if ((lon2-lon1) > three*pih) then
+        lon2 = lon2 - pi2
+      else if ((lon2-lon1) < -three*pih) then
+        lon2 = lon2 + pi2
+      endif
+      s1 = zero
+
+!-----------------------------------------------------------------------
+!
+!     search for location of this segment in ocean grid using cross
+!     product method to determine whether a point is enclosed by a cell
+!
+!-----------------------------------------------------------------------
+
+      call timer_start(12)
+      srch_corners = size(srch_corner_lat,DIM=1)
+      srch_loop: do
+
+        !***
+        !*** if last segment crossed threshold, use that location
+        !***
+
+        if (lthresh) then
+          do cell=1,num_srch_cells
+            if (srch_add(cell) == last_loc) then
+              location = last_loc
+              eps = tiny
+              exit srch_loop
+            endif
+          end do
+        endif
+
+        !***
+        !*** otherwise normal search algorithm
+        !***
+
+        cell_loop: do cell=1,num_srch_cells
+          corner_loop: do n=1,srch_corners
+            next_n = MOD(n,srch_corners) + 1
+
+            !***
+            !*** here we take the cross product of the vector making 
+            !*** up each cell side with the vector formed by the vertex
+            !*** and search point.  if all the cross products are 
+            !*** positive, the point is contained in the cell.
+            !***
+
+            vec1_lat = srch_corner_lat(next_n,cell) -  &
+                       srch_corner_lat(n     ,cell)
+            vec1_lon = srch_corner_lon(next_n,cell) -  &
+                       srch_corner_lon(n     ,cell)
+            vec2_lat = lat1 - srch_corner_lat(n,cell)
+            vec2_lon = lon1 - srch_corner_lon(n,cell)
+
+            !***
+            !*** if endpoint coincident with vertex, offset
+            !*** the endpoint
+            !***
+
+            if (vec2_lat == 0 .and. vec2_lon == 0) then
+              lat1 = lat1 + 1.d-10*(lat2-lat1)
+              lon1 = lon1 + 1.d-10*(lon2-lon1)
+              vec2_lat = lat1 - srch_corner_lat(n,cell)
+              vec2_lon = lon1 - srch_corner_lon(n,cell)
+            endif
+
+            !***
+            !*** check for 0,2pi crossings
+            !***
+
+            if (vec1_lon >  pi) then
+              vec1_lon = vec1_lon - pi2
+            else if (vec1_lon < -pi) then
+              vec1_lon = vec1_lon + pi2
+            endif
+            if (vec2_lon >  pi) then
+              vec2_lon = vec2_lon - pi2
+            else if (vec2_lon < -pi) then
+              vec2_lon = vec2_lon + pi2
+            endif
+
+            cross_product = vec1_lon*vec2_lat - vec2_lon*vec1_lat
+
+            !***
+            !*** if the cross product for a side is zero, the point 
+            !***   lies exactly on the side or the side is degenerate
+            !***   (zero length).  if degenerate, set the cross 
+            !***   product to a positive number.  otherwise perform 
+            !***   another cross product between the side and the 
+            !***   segment itself. 
+            !*** if this cross product is also zero, the line is 
+            !***   coincident with the cell boundary - perform the 
+            !***   dot product and only choose the cell if the dot 
+            !***   product is positive (parallel vs anti-parallel).
+            !***
+
+            if (cross_product == zero) then
+              if (vec1_lat /= zero .or. vec1_lon /= zero) then
+                vec2_lat = lat2 - lat1
+                vec2_lon = lon2 - lon1
+
+                if (vec2_lon >  pi) then
+                  vec2_lon = vec2_lon - pi2
+                else if (vec2_lon < -pi) then
+                  vec2_lon = vec2_lon + pi2
+                endif
+
+                cross_product = vec1_lon*vec2_lat - vec2_lon*vec1_lat
+              else
+                cross_product = one
+              endif
+
+              if (cross_product == zero) then
+                lcoinc = .true.
+                cross_product = vec1_lon*vec2_lon + vec1_lat*vec2_lat
+                if (lrevers) cross_product = -cross_product
+              endif
+            endif
+
+            !***
+            !*** if cross product is less than zero, this cell
+            !*** doesn't work
+            !***
+
+            if (cross_product < zero) exit corner_loop
+
+          end do corner_loop
+
+          !***
+          !*** if cross products all positive, we found the location
+          !***
+
+          if (n > srch_corners) then
+            location = srch_add(cell)
+
+            !***
+            !*** if the beginning of this segment was outside the
+            !*** grid, invert the segment so the intersection found
+            !*** will be the first intersection with the grid
+            !***
+
+            if (loutside) then
+              lat2 = beglat
+              lon2 = beglon
+              location = 0
+              eps  = -tiny
+            else
+              eps  = tiny
+            endif
+
+            exit srch_loop
+          endif
+
+          !***
+          !*** otherwise move on to next cell
+          !***
+
+        end do cell_loop
+
+        !***
+        !*** if still no cell found, the point lies outside the grid.
+        !***   take some baby steps along the segment to see if any
+        !***   part of the segment lies inside the grid.  
+        !***
+
+        loutside = .true.
+        s1 = s1 + 0.001_dbl_kind
+        lat1 = beglat + s1*(endlat - beglat)
+        lon1 = beglon + s1*(lon2   - beglon)
+
+        !***
+        !*** reached the end of the segment and still outside the grid
+        !*** return no intersection
+        !***
+
+        if (s1 >= one) return
+
+      end do srch_loop
+      call timer_stop(12)
+
+!-----------------------------------------------------------------------
+!
+!     now that a cell is found, search for the next intersection.
+!     loop over sides of the cell to find intersection with side
+!     must check all sides for coincidences or intersections
+!
+!-----------------------------------------------------------------------
+
+      call timer_start(13)
+      intrsct_loop: do n=1,srch_corners
+        next_n = mod(n,srch_corners) + 1
+
+        grdlon1 = srch_corner_lon(n     ,cell)
+        grdlon2 = srch_corner_lon(next_n,cell)
+        grdlat1 = srch_corner_lat(n     ,cell)
+        grdlat2 = srch_corner_lat(next_n,cell)
+
+        !***
+        !*** set up linear system to solve for intersection
+        !***
+
+        mat1 = lat2 - lat1
+        mat2 = grdlat1 - grdlat2
+        mat3 = lon2 - lon1
+        mat4 = grdlon1 - grdlon2
+        rhs1 = grdlat1 - lat1
+        rhs2 = grdlon1 - lon1
+
+        if (mat3 >  pi) then
+          mat3 = mat3 - pi2
+        else if (mat3 < -pi) then
+          mat3 = mat3 + pi2
+        endif
+        if (mat4 >  pi) then
+          mat4 = mat4 - pi2
+        else if (mat4 < -pi) then
+          mat4 = mat4 + pi2
+        endif
+        if (rhs2 >  pi) then
+          rhs2 = rhs2 - pi2
+        else if (rhs2 < -pi) then
+          rhs2 = rhs2 + pi2
+        endif
+
+        determ = mat1*mat4 - mat2*mat3
+
+        !***
+        !*** if the determinant is zero, the segments are either 
+        !***   parallel or coincident.  coincidences were detected 
+        !***   above so do nothing.
+        !*** if the determinant is non-zero, solve for the linear 
+        !***   parameters s for the intersection point on each line 
+        !***   segment.
+        !*** if 0<s1,s2<1 then the segment intersects with this side.
+        !***   return the point of intersection (adding a small
+        !***   number so the intersection is off the grid line).
+        !***
+
+        if (abs(determ) > 1.e-30) then
+
+          s1 = (rhs1*mat4 - mat2*rhs2)/determ
+          s2 = (mat1*rhs2 - rhs1*mat3)/determ
+
+          if (s2 >= zero .and. s2 <= one .and. &
+              s1 >  zero .and. s1 <= one) then
+
+            !***
+            !*** recompute intersection based on full segment
+            !*** so intersections are consistent for both sweeps
+            !***
+
+            if (.not. loutside) then
+              mat1 = lat2 - begseg(1)
+              mat3 = lon2 - begseg(2)
+              rhs1 = grdlat1 - begseg(1)
+              rhs2 = grdlon1 - begseg(2)
+            else
+              mat1 = begseg(1) - endlat
+              mat3 = begseg(2) - endlon
+              rhs1 = grdlat1 - endlat
+              rhs2 = grdlon1 - endlon
+            endif
+
+            if (mat3 >  pi) then
+              mat3 = mat3 - pi2
+            else if (mat3 < -pi) then
+              mat3 = mat3 + pi2
+            endif
+            if (rhs2 >  pi) then
+              rhs2 = rhs2 - pi2
+            else if (rhs2 < -pi) then
+              rhs2 = rhs2 + pi2
+            endif
+
+            determ = mat1*mat4 - mat2*mat3
+
+            !***
+            !*** sometimes due to roundoff, the previous 
+            !*** determinant is non-zero, but the lines
+            !*** are actually coincident.  if this is the
+            !*** case, skip the rest.
+            !***
+
+            if (determ /= zero) then
+              s1 = (rhs1*mat4 - mat2*rhs2)/determ
+              s2 = (mat1*rhs2 - rhs1*mat3)/determ
+
+              offset = s1 + eps/determ
+              if (offset > one) offset = one
+
+              if (.not. loutside) then
+                intrsct_lat = begseg(1) + mat1*s1
+                intrsct_lon = begseg(2) + mat3*s1
+                intrsct_lat_off = begseg(1) + mat1*offset
+                intrsct_lon_off = begseg(2) + mat3*offset
+              else
+                intrsct_lat = endlat + mat1*s1
+                intrsct_lon = endlon + mat3*s1
+                intrsct_lat_off = endlat + mat1*offset
+                intrsct_lon_off = endlon + mat3*offset
+              endif
+              exit intrsct_loop
+            endif
+
+          endif
+        endif
+
+        !***
+        !*** no intersection this side, move on to next side
+        !***
+
+      end do intrsct_loop
+      call timer_stop(13)
+
+!-----------------------------------------------------------------------
+!
+!     if the segment crosses a pole threshold, reset the intersection
+!     to be the threshold latitude.  only check if this was not a
+!     threshold segment since sometimes coordinate transform can end
+!     up on other side of threshold again.
+!
+!-----------------------------------------------------------------------
+
+      if (lthresh) then
+        if (intrsct_lat < north_thresh .or. intrsct_lat > south_thresh) &
+            lthresh = .false.
+      else if (lat1 > zero .and. intrsct_lat > north_thresh) then
+        intrsct_lat = north_thresh + tiny
+        intrsct_lat_off = north_thresh + eps*mat1
+        s1 = (intrsct_lat - begseg(1))/mat1
+        intrsct_lon     = begseg(2) + s1*mat3
+        intrsct_lon_off = begseg(2) + (s1+eps)*mat3
+        last_loc = location
+        lthresh = .true.
+      else if (lat1 < zero .and. intrsct_lat < south_thresh) then
+        intrsct_lat = south_thresh - tiny
+        intrsct_lat_off = south_thresh + eps*mat1
+        s1 = (intrsct_lat - begseg(1))/mat1
+        intrsct_lon     = begseg(2) + s1*mat3
+        intrsct_lon_off = begseg(2) + (s1+eps)*mat3
+        last_loc = location
+        lthresh = .true.
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine intersection
+
+!***********************************************************************
+
+      subroutine pole_intersection(location, &
+                       intrsct_lat,intrsct_lon,lcoinc,lthresh, &
+                       beglat, beglon, endlat, endlon, begseg, lrevers)
+
+!-----------------------------------------------------------------------
+!
+!     this routine is identical to the intersection routine except
+!     that a coordinate transformation (using a Lambert azimuthal
+!     equivalent projection) is performed to treat polar cells more
+!     accurately.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     intent(in): 
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), intent(in) ::  &
+           beglat, beglon,   & ! beginning lat/lon endpoints for segment
+           endlat, endlon   ! ending    lat/lon endpoints for segment
+
+      real (kind=dbl_kind), dimension(2), intent(inout) ::  &
+           begseg ! begin lat/lon of full segment
+
+      logical (kind=log_kind), intent(in) :: &
+              lrevers   ! flag true if segment integrated in reverse
+
+!-----------------------------------------------------------------------
+!
+!     intent(out): 
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(inout) :: &
+              location  ! address in destination array containing this
+                        ! segment -- also may contain last location on
+                        ! entry
+
+      logical (kind=log_kind), intent(out) :: &
+              lcoinc    ! flag segment coincident with grid line
+
+      logical (kind=log_kind), intent(inout) :: &
+              lthresh   ! flag segment crossing threshold boundary
+
+      real (kind=dbl_kind), intent(out) :: &
+           intrsct_lat, intrsct_lon ! lat/lon coords of next intersect.
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, next_n, cell, srch_corners, pole_loc
+
+      logical (kind=log_kind) :: loutside ! flags points outside grid
+
+      real (kind=dbl_kind) :: pi4, rns,  & ! north/south conversion
+           x1, x2,        & ! local x variables for segment
+           y1, y2,        & ! local y variables for segment
+           begx, begy,    & ! beginning x,y variables for segment
+           endx, endy,    & ! beginning x,y variables for segment
+           begsegx, begsegy,    & ! beginning x,y variables for segment
+           grdx1, grdx2,  & ! local x variables for grid cell
+           grdy1, grdy2,  & ! local y variables for grid cell
+           vec1_y, vec1_x,  & ! vectors and cross products used
+           vec2_y, vec2_x,  & ! during grid search
+           cross_product, eps,  & ! eps=small offset away from intersect
+           s1, s2, determ,      & ! variables used for linear solve to
+           mat1, mat2, mat3, mat4, rhs1, rhs2  ! find intersection
+
+      real (kind=dbl_kind), dimension(:,:), allocatable :: &
+           srch_corner_x,   & ! x of each corner of srch cells
+           srch_corner_y   ! y of each corner of srch cells
+
+      !***
+      !*** save last intersection to avoid roundoff during coord
+      !*** transformation
+      !***
+
+      logical (kind=log_kind), save :: luse_last = .false.
+
+      real (kind=dbl_kind), save ::  &
+           intrsct_x, intrsct_y  ! x,y for intersection
+
+      !***
+      !*** variables necessary if segment manages to hit pole
+      !***
+
+      integer (kind=int_kind), save ::  &
+           avoid_pole_count = 0  ! count attempts to avoid pole
+
+      real (kind=dbl_kind), save ::  &
+           avoid_pole_offset = tiny  ! endpoint offset to avoid pole
+
+!-----------------------------------------------------------------------
+!
+!     initialize defaults, flags, etc.
+!
+!-----------------------------------------------------------------------
+
+      if (.not. lthresh) location = 0
+      lcoinc = .false.
+      intrsct_lat = endlat
+      intrsct_lon = endlon
+
+      loutside = .false.
+      s1 = zero
+
+!-----------------------------------------------------------------------
+!
+!     convert coordinates
+!
+!-----------------------------------------------------------------------
+
+      allocate(srch_corner_x(size(srch_corner_lat,DIM=1), &
+                             size(srch_corner_lat,DIM=2)), &
+               srch_corner_y(size(srch_corner_lat,DIM=1), &
+                             size(srch_corner_lat,DIM=2)))
+
+      if (beglat > zero) then
+        pi4 = quart*pi
+        rns = one
+      else
+        pi4 = -quart*pi
+        rns = -one
+      endif
+
+      if (luse_last) then
+        x1 = intrsct_x
+        y1 = intrsct_y
+      else
+        x1 = rns*two*sin(pi4 - half*beglat)*cos(beglon)
+        y1 =     two*sin(pi4 - half*beglat)*sin(beglon)
+        luse_last = .true.
+      endif
+      x2 = rns*two*sin(pi4 - half*endlat)*cos(endlon)
+      y2 =     two*sin(pi4 - half*endlat)*sin(endlon)
+      srch_corner_x = rns*two*sin(pi4 - half*srch_corner_lat)* &
+                              cos(srch_corner_lon)
+      srch_corner_y =     two*sin(pi4 - half*srch_corner_lat)* &
+                              sin(srch_corner_lon)
+
+      begx = x1
+      begy = y1
+      endx = x2
+      endy = y2
+      begsegx = rns*two*sin(pi4 - half*begseg(1))*cos(begseg(2))
+      begsegy =     two*sin(pi4 - half*begseg(1))*sin(begseg(2))
+      intrsct_x = endx
+      intrsct_y = endy
+
+!-----------------------------------------------------------------------
+!
+!     search for location of this segment in ocean grid using cross
+!     product method to determine whether a point is enclosed by a cell
+!
+!-----------------------------------------------------------------------
+
+      call timer_start(12)
+      srch_corners = size(srch_corner_lat,DIM=1)
+      srch_loop: do
+
+        !***
+        !*** if last segment crossed threshold, use that location
+        !***
+
+        if (lthresh) then
+          do cell=1,num_srch_cells
+            if (srch_add(cell) == location) then
+              eps = tiny
+              exit srch_loop
+            endif
+          end do
+        endif
+
+        !***
+        !*** otherwise normal search algorithm
+        !***
+
+        cell_loop: do cell=1,num_srch_cells
+          corner_loop: do n=1,srch_corners
+            next_n = MOD(n,srch_corners) + 1
+
+            !***
+            !*** here we take the cross product of the vector making 
+            !*** up each cell side with the vector formed by the vertex
+            !*** and search point.  if all the cross products are 
+            !*** positive, the point is contained in the cell.
+            !***
+
+            vec1_x = srch_corner_x(next_n,cell) -  &
+                     srch_corner_x(n     ,cell)
+            vec1_y = srch_corner_y(next_n,cell) -  &
+                     srch_corner_y(n     ,cell)
+            vec2_x = x1 - srch_corner_x(n,cell)
+            vec2_y = y1 - srch_corner_y(n,cell)
+
+            !***
+            !*** if endpoint coincident with vertex, offset
+            !*** the endpoint
+            !***
+
+            if (vec2_x == 0 .and. vec2_y == 0) then
+              x1 = x1 + 1.d-10*(x2-x1)
+              y1 = y1 + 1.d-10*(y2-y1)
+              vec2_x = x1 - srch_corner_x(n,cell)
+              vec2_y = y1 - srch_corner_y(n,cell)
+            endif
+
+            cross_product = vec1_x*vec2_y - vec2_x*vec1_y
+
+            !***
+            !*** if the cross product for a side is zero, the point 
+            !***   lies exactly on the side or the length of a side
+            !***   is zero.  if the length is zero set det > 0.
+            !***   otherwise, perform another cross 
+            !***   product between the side and the segment itself. 
+            !*** if this cross product is also zero, the line is 
+            !***   coincident with the cell boundary - perform the 
+            !***   dot product and only choose the cell if the dot 
+            !***   product is positive (parallel vs anti-parallel).
+            !***
+
+            if (cross_product == zero) then
+              if (vec1_x /= zero .or. vec1_y /= 0) then
+                vec2_x = x2 - x1
+                vec2_y = y2 - y1
+                cross_product = vec1_x*vec2_y - vec2_x*vec1_y
+              else
+                cross_product = one
+              endif
+
+              if (cross_product == zero) then
+                lcoinc = .true.
+                cross_product = vec1_x*vec2_x + vec1_y*vec2_y
+                if (lrevers) cross_product = -cross_product
+              endif
+            endif
+
+            !***
+            !*** if cross product is less than zero, this cell
+            !*** doesn't work
+            !***
+
+            if (cross_product < zero) exit corner_loop
+
+          end do corner_loop
+
+          !***
+          !*** if cross products all positive, we found the location
+          !***
+
+          if (n > srch_corners) then
+            location = srch_add(cell)
+
+            !***
+            !*** if the beginning of this segment was outside the
+            !*** grid, invert the segment so the intersection found
+            !*** will be the first intersection with the grid
+            !***
+
+            if (loutside) then
+              x2 = begx
+              y2 = begy
+              location = 0
+              eps  = -tiny
+            else
+              eps  = tiny
+            endif
+
+            exit srch_loop
+          endif
+
+          !***
+          !*** otherwise move on to next cell
+          !***
+
+        end do cell_loop
+
+        !***
+        !*** if no cell found, the point lies outside the grid.
+        !***   take some baby steps along the segment to see if any
+        !***   part of the segment lies inside the grid.  
+        !***
+
+        loutside = .true.
+        s1 = s1 + 0.001_dbl_kind
+        x1 = begx + s1*(x2 - begx)
+        y1 = begy + s1*(y2 - begy)
+
+        !***
+        !*** reached the end of the segment and still outside the grid
+        !*** return no intersection
+        !***
+
+        if (s1 >= one) then
+          deallocate(srch_corner_x, srch_corner_y)
+          luse_last = .false.
+          return
+        endif
+
+      end do srch_loop
+      call timer_stop(12)
+
+!-----------------------------------------------------------------------
+!
+!     now that a cell is found, search for the next intersection.
+!     loop over sides of the cell to find intersection with side
+!     must check all sides for coincidences or intersections
+!
+!-----------------------------------------------------------------------
+
+      call timer_start(13)
+      intrsct_loop: do n=1,srch_corners
+        next_n = mod(n,srch_corners) + 1
+
+        grdy1 = srch_corner_y(n     ,cell)
+        grdy2 = srch_corner_y(next_n,cell)
+        grdx1 = srch_corner_x(n     ,cell)
+        grdx2 = srch_corner_x(next_n,cell)
+
+        !***
+        !*** set up linear system to solve for intersection
+        !***
+
+        mat1 = x2 - x1
+        mat2 = grdx1 - grdx2
+        mat3 = y2 - y1
+        mat4 = grdy1 - grdy2
+        rhs1 = grdx1 - x1
+        rhs2 = grdy1 - y1
+
+        determ = mat1*mat4 - mat2*mat3
+
+        !***
+        !*** if the determinant is zero, the segments are either 
+        !***   parallel or coincident or one segment has zero length.  
+        !***   coincidences were detected above so do nothing.
+        !*** if the determinant is non-zero, solve for the linear 
+        !***   parameters s for the intersection point on each line 
+        !***   segment.
+        !*** if 0<s1,s2<1 then the segment intersects with this side.
+        !***   return the point of intersection (adding a small
+        !***   number so the intersection is off the grid line).
+        !***
+
+        if (abs(determ) > 1.e-30) then
+
+          s1 = (rhs1*mat4 - mat2*rhs2)/determ
+          s2 = (mat1*rhs2 - rhs1*mat3)/determ
+
+          if (s2 >= zero .and. s2 <= one .and. &
+              s1 >  zero .and. s1 <= one) then
+
+            !***
+            !*** recompute intersection using entire segment
+            !*** for consistency between sweeps
+            !***
+
+            if (.not. loutside) then
+              mat1 = x2 - begsegx
+              mat3 = y2 - begsegy
+              rhs1 = grdx1 - begsegx
+              rhs2 = grdy1 - begsegy
+            else 
+              mat1 = x2 - endx
+              mat3 = y2 - endy
+              rhs1 = grdx1 - endx
+              rhs2 = grdy1 - endy
+            endif
+
+            determ = mat1*mat4 - mat2*mat3
+
+            !***
+            !*** sometimes due to roundoff, the previous 
+            !*** determinant is non-zero, but the lines
+            !*** are actually coincident.  if this is the
+            !*** case, skip the rest.
+            !***
+
+            if (determ /= zero) then
+              s1 = (rhs1*mat4 - mat2*rhs2)/determ
+              s2 = (mat1*rhs2 - rhs1*mat3)/determ
+
+              if (.not. loutside) then
+                intrsct_x = begsegx + s1*mat1
+                intrsct_y = begsegy + s1*mat3
+              else 
+                intrsct_x = endx + s1*mat1
+                intrsct_y = endy + s1*mat3
+              endif
+
+              !***
+              !*** convert back to lat/lon coordinates
+              !***
+
+              intrsct_lon = rns*atan2(intrsct_y,intrsct_x)
+              if (intrsct_lon < zero)  &
+                intrsct_lon = intrsct_lon + pi2
+
+              if (abs(intrsct_x) > 1.d-10) then
+                intrsct_lat = (pi4 -  &
+                  asin(rns*half*intrsct_x/cos(intrsct_lon)))*two
+              else if (abs(intrsct_y) > 1.d-10) then
+                intrsct_lat = (pi4 -  &
+                  asin(half*intrsct_y/sin(intrsct_lon)))*two
+              else
+                intrsct_lat = two*pi4
+              endif
+
+              !***
+              !*** add offset in transformed space for next pass.
+              !***
+
+              if (s1 - eps/determ < one) then
+                intrsct_x = intrsct_x - mat1*(eps/determ)
+                intrsct_y = intrsct_y - mat3*(eps/determ)
+              else
+                if (.not. loutside) then
+                  intrsct_x = endx
+                  intrsct_y = endy
+                  intrsct_lat = endlat
+                  intrsct_lon = endlon
+                else 
+                  intrsct_x = begsegx
+                  intrsct_y = begsegy
+                  intrsct_lat = begseg(1)
+                  intrsct_lon = begseg(2)
+                endif
+              endif
+
+              exit intrsct_loop
+            endif
+          endif
+        endif
+
+        !***
+        !*** no intersection this side, move on to next side
+        !***
+
+      end do intrsct_loop
+      call timer_stop(13)
+
+      deallocate(srch_corner_x, srch_corner_y)
+
+!-----------------------------------------------------------------------
+!
+!     if segment manages to cross over pole, shift the beginning 
+!     endpoint in order to avoid hitting pole directly
+!     (it is ok for endpoint to be pole point)
+!
+!-----------------------------------------------------------------------
+
+      if (abs(intrsct_x) < 1.e-10 .and. abs(intrsct_y) < 1.e-10 .and. &
+          (endx /= zero .and. endy /=0)) then
+        if (avoid_pole_count > 2) then
+           avoid_pole_count = 0
+           avoid_pole_offset = 10.*avoid_pole_offset
+        endif
+
+        cross_product = begsegx*(endy-begsegy) - begsegy*(endx-begsegx)
+        intrsct_lat = begseg(1)
+        if (cross_product*intrsct_lat > zero) then
+          intrsct_lon = beglon    + avoid_pole_offset
+          begseg(2)   = begseg(2) + avoid_pole_offset
+        else
+          intrsct_lon = beglon    - avoid_pole_offset
+          begseg(2)   = begseg(2) - avoid_pole_offset
+        endif
+
+        avoid_pole_count = avoid_pole_count + 1
+        luse_last = .false.
+      else
+        avoid_pole_count = 0
+        avoid_pole_offset = tiny
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     if the segment crosses a pole threshold, reset the intersection
+!     to be the threshold latitude and do not reuse x,y intersect
+!     on next entry.  only check if did not cross threshold last
+!     time - sometimes the coordinate transformation can place a
+!     segment on the other side of the threshold again
+!
+!-----------------------------------------------------------------------
+
+      if (lthresh) then
+        if (intrsct_lat > north_thresh .or. intrsct_lat < south_thresh) &
+          lthresh = .false.
+      else if (beglat > zero .and. intrsct_lat < north_thresh) then
+        mat4 = endlat - begseg(1)
+        mat3 = endlon - begseg(2)
+        if (mat3 >  pi) mat3 = mat3 - pi2
+        if (mat3 < -pi) mat3 = mat3 + pi2
+        intrsct_lat = north_thresh - tiny
+        s1 = (north_thresh - begseg(1))/mat4
+        intrsct_lon = begseg(2) + s1*mat3
+        luse_last = .false.
+        lthresh = .true.
+      else if (beglat < zero .and. intrsct_lat > south_thresh) then
+        mat4 = endlat - begseg(1)
+        mat3 = endlon - begseg(2)
+        if (mat3 >  pi) mat3 = mat3 - pi2
+        if (mat3 < -pi) mat3 = mat3 + pi2
+        intrsct_lat = south_thresh + tiny
+        s1 = (south_thresh - begseg(1))/mat4
+        intrsct_lon = begseg(2) + s1*mat3
+        luse_last = .false.
+        lthresh = .true.
+      endif
+
+      !***
+      !*** if reached end of segment, do not use x,y intersect 
+      !*** on next entry
+      !***
+
+      if (intrsct_lat == endlat .and. intrsct_lon == endlon) then
+        luse_last = .false.
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine pole_intersection
+
+!***********************************************************************
+
+      subroutine line_integral(weights, num_wts,  &
+                             in_phi1, in_phi2, theta1, theta2, &
+                             grid1_lat, grid1_lon, grid2_lat, grid2_lon)
+
+!-----------------------------------------------------------------------
+!
+!     this routine computes the line integral of the flux function 
+!     that results in the interpolation weights.  the line is defined
+!     by the input lat/lon of the endpoints.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     intent(in):
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) :: &
+              num_wts  ! number of weights to compute
+
+      real (kind=dbl_kind), intent(in) ::  &
+           in_phi1, in_phi2,      & ! longitude endpoints for the segment
+           theta1, theta2,        & ! latitude  endpoints for the segment
+           grid1_lat, grid1_lon,  & ! reference coordinates for each
+           grid2_lat, grid2_lon  ! grid (to ensure correct 0,2pi interv.
+
+!-----------------------------------------------------------------------
+!
+!     intent(out):
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), dimension(2*num_wts), intent(out) :: &
+           weights   ! line integral contribution to weights
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind) :: dphi, sinth1, sinth2, costh1, costh2, fac, &
+                              phi1, phi2, phidiff1, phidiff2, sinint
+      real (kind=dbl_kind) :: f1, f2, fint
+
+!-----------------------------------------------------------------------
+!
+!     weights for the general case based on a trapezoidal approx to
+!     the integrals.
+!
+!-----------------------------------------------------------------------
+
+      sinth1 = SIN(theta1)
+      sinth2 = SIN(theta2)
+      costh1 = COS(theta1)
+      costh2 = COS(theta2)
+
+      dphi = in_phi1 - in_phi2
+      if (dphi >  pi) then
+        dphi = dphi - pi2
+      else if (dphi < -pi) then
+        dphi = dphi + pi2
+      endif
+      dphi = half*dphi
+
+!-----------------------------------------------------------------------
+!
+!     the first weight is the area overlap integral. the second and
+!     fourth are second-order latitude gradient weights.
+!
+!-----------------------------------------------------------------------
+
+      weights(        1) = dphi*(sinth1 + sinth2)
+      weights(num_wts+1) = dphi*(sinth1 + sinth2)
+      weights(        2) = dphi*(costh1 + costh2 + (theta1*sinth1 + &
+                                                    theta2*sinth2))
+      weights(num_wts+2) = dphi*(costh1 + costh2 + (theta1*sinth1 + &
+                                                    theta2*sinth2))
+
+!-----------------------------------------------------------------------
+!
+!     the third and fifth weights are for the second-order phi gradient
+!     component.  must be careful of longitude range.
+!
+!-----------------------------------------------------------------------
+
+      f1 = half*(costh1*sinth1 + theta1)
+      f2 = half*(costh2*sinth2 + theta2)
+
+      phi1 = in_phi1 - grid1_lon
+      if (phi1 >  pi) then
+        phi1 = phi1 - pi2
+      else if (phi1 < -pi) then
+        phi1 = phi1 + pi2
+      endif
+
+      phi2 = in_phi2 - grid1_lon
+      if (phi2 >  pi) then
+        phi2 = phi2 - pi2
+      else if (phi2 < -pi) then
+        phi2 = phi2 + pi2
+      endif
+
+      if ((phi2-phi1) <  pi .and. (phi2-phi1) > -pi) then
+        weights(3) = dphi*(phi1*f1 + phi2*f2)
+      else
+        if (phi1 > zero) then
+          fac = pi
+        else
+          fac = -pi
+        endif
+        fint = f1 + (f2-f1)*(fac-phi1)/abs(dphi)
+        weights(3) = half*phi1*(phi1-fac)*f1 - &
+                     half*phi2*(phi2+fac)*f2 + &
+                     half*fac*(phi1+phi2)*fint
+      endif
+
+      phi1 = in_phi1 - grid2_lon
+      if (phi1 >  pi) then
+        phi1 = phi1 - pi2
+      else if (phi1 < -pi) then
+        phi1 = phi1 + pi2
+      endif
+
+      phi2 = in_phi2 - grid2_lon
+      if (phi2 >  pi) then
+        phi2 = phi2 - pi2
+      else if (phi2 < -pi) then
+        phi2 = phi2 + pi2
+      endif
+
+      if ((phi2-phi1) <  pi .and. (phi2-phi1) > -pi) then
+        weights(num_wts+3) = dphi*(phi1*f1 + phi2*f2)
+      else
+        if (phi1 > zero) then
+          fac = pi
+        else
+          fac = -pi
+        endif
+        fint = f1 + (f2-f1)*(fac-phi1)/abs(dphi)
+        weights(num_wts+3) = half*phi1*(phi1-fac)*f1 - &
+                             half*phi2*(phi2+fac)*f2 + &
+                             half*fac*(phi1+phi2)*fint
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine line_integral
+
+!***********************************************************************
+
+      subroutine store_link_cnsrv(add1, add2, weights)
+
+!-----------------------------------------------------------------------
+!
+!     this routine stores the address and weight for this link in
+!     the appropriate address and weight arrays and resizes those
+!     arrays if necessary.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) :: &
+              add1,   & ! address on grid1
+              add2   ! address on grid2
+
+      real (kind=dbl_kind), dimension(:), intent(in) :: &
+              weights ! array of remapping weights for this link
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: nlink, min_link, max_link ! link index
+
+      integer (kind=int_kind), dimension(:,:), allocatable, save :: &
+              link_add1,   & ! min,max link add to restrict search
+              link_add2   ! min,max link add to restrict search
+
+      logical (kind=log_kind), save :: first_call = .true.
+
+!-----------------------------------------------------------------------
+!
+!     if all weights are zero, do not bother storing the link
+!
+!-----------------------------------------------------------------------
+
+      if (all(weights == zero)) return
+
+!-----------------------------------------------------------------------
+!
+!     restrict the range of links to search for existing links
+!
+!-----------------------------------------------------------------------
+
+      if (first_call) then
+        allocate(link_add1(2,grid1_size), link_add2(2,grid2_size))
+        link_add1 = 0
+        link_add2 = 0
+        first_call = .false.
+        min_link = 1
+        max_link = 0
+      else
+        min_link = min(link_add1(1,add1),link_add2(1,add2))
+        max_link = max(link_add1(2,add1),link_add2(2,add2))
+        if (min_link == 0) then
+          min_link = 1
+          max_link = 0
+        endif
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     if the link already exists, add the weight to the current weight
+!     arrays
+!
+!-----------------------------------------------------------------------
+
+      do nlink=min_link,max_link
+        if (add1 == grid1_add_map1(nlink)) then
+        if (add2 == grid2_add_map1(nlink)) then
+
+          wts_map1(:,nlink) = wts_map1(:,nlink) + weights(1:num_wts)
+          if (num_maps == 2) then
+            wts_map2(:,nlink) = wts_map2(:,nlink) +  &
+                                        weights(num_wts+1:2*num_wts)
+          endif
+          return
+
+        endif
+        endif
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     if the link does not yet exist, increment number of links and 
+!     check to see if remap arrays need to be increased to accomodate 
+!     the new link.  then store the link.
+!
+!-----------------------------------------------------------------------
+
+      num_links_map1  = num_links_map1 + 1
+      if (num_links_map1 > max_links_map1)  &
+         call resize_remap_vars(1,resize_increment)
+
+      grid1_add_map1(num_links_map1) = add1
+      grid2_add_map1(num_links_map1) = add2
+      wts_map1    (:,num_links_map1) = weights(1:num_wts)
+
+      if (num_maps > 1) then
+        num_links_map2  = num_links_map2 + 1
+        if (num_links_map2 > max_links_map2)  &
+           call resize_remap_vars(2,resize_increment)
+
+        grid1_add_map2(num_links_map2) = add1
+        grid2_add_map2(num_links_map2) = add2
+        wts_map2    (:,num_links_map2) = weights(num_wts+1:2*num_wts)
+      endif
+
+      if (link_add1(1,add1) == 0) link_add1(1,add1) = num_links_map1
+      if (link_add2(1,add2) == 0) link_add2(1,add2) = num_links_map1
+      link_add1(2,add1) = num_links_map1
+      link_add2(2,add2) = num_links_map1
+
+!-----------------------------------------------------------------------
+
+      end subroutine store_link_cnsrv
+
+!***********************************************************************
+
+      end module remap_conservative
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/remap_distwgt.f90
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/remap_distwgt.f90	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/remap_distwgt.f90	(revision 2352)
@@ -0,0 +1,498 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary routines for performing an 
+!     interpolation using a distance-weighted average of n nearest
+!     neighbors.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_distwgt.f,v 1.3 2000/04/19 21:56:26 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_distance_weight
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common constants
+      use grids         ! module containing grid info
+      use remap_vars    ! module containing remap info
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter ::  &
+           num_neighbors=4  ! num nearest neighbors to interpolate from
+
+      real (kind=dbl_kind), dimension(:), allocatable, save :: &
+           coslat, sinlat,  & ! cosine, sine of grid lats (for distance)
+           coslon, sinlon,  & ! cosine, sine of grid lons (for distance)
+           wgtstmp         ! an array to hold the link weight
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap_distwgt
+
+!-----------------------------------------------------------------------
+!
+!     this routine computes the inverse-distance weights for a
+!     nearest-neighbor interpolation.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      logical (kind=log_kind), dimension(num_neighbors) :: &
+           nbr_mask        ! mask at nearest neighbors
+
+      integer (kind=int_kind) :: n, &
+           dst_add,         & ! destination address
+           nmap            ! index of current map being computed
+
+      integer (kind=int_kind), dimension(num_neighbors) :: &
+           nbr_add         ! source address at nearest neighbors
+
+      real (kind=dbl_kind), dimension(num_neighbors) :: &
+           nbr_dist        ! angular distance four nearest neighbors
+
+      real (kind=dbl_kind) :: &
+           coslat_dst,      & ! cos(lat) of destination grid point
+           coslon_dst,      & ! cos(lon) of destination grid point
+           sinlat_dst,      & ! sin(lat) of destination grid point
+           sinlon_dst,      & ! sin(lon) of destination grid point
+           dist_tot        ! sum of neighbor distances (for normalizing)
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid1 to grid2
+!
+!-----------------------------------------------------------------------
+
+      nmap = 1
+
+      !***
+      !*** allocate wgtstmp to be consistent with store_link interface
+      !***
+
+      allocate (wgtstmp(num_wts))
+
+      !***
+      !*** compute cos, sin of lat/lon on source grid for distance
+      !*** calculations
+      !***
+
+      allocate (coslat(grid1_size), coslon(grid1_size), &
+                sinlat(grid1_size), sinlon(grid1_size))
+
+      coslat = cos(grid1_center_lat)
+      coslon = cos(grid1_center_lon)
+      sinlat = sin(grid1_center_lat)
+      sinlon = sin(grid1_center_lon)
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop1: do dst_add = 1, grid2_size
+
+        if (.not. grid2_mask(dst_add)) cycle grid_loop1
+
+        coslat_dst = cos(grid2_center_lat(dst_add))
+        coslon_dst = cos(grid2_center_lon(dst_add))
+        sinlat_dst = sin(grid2_center_lat(dst_add))
+        sinlon_dst = sin(grid2_center_lon(dst_add))
+
+        !***
+        !*** find nearest grid points on source grid and
+        !*** distances to each point
+        !***
+
+        call grid_search_nbr(nbr_add, nbr_dist,  &
+                             grid2_center_lat(dst_add), &
+                             grid2_center_lon(dst_add), &
+                             coslat_dst, coslon_dst,  &
+                             sinlat_dst, sinlon_dst, &
+                             bin_addr1, bin_addr2)
+
+        !***
+        !*** compute weights based on inverse distance
+        !*** if mask is false, eliminate those points
+        !***
+
+        dist_tot = zero
+        do n=1,num_neighbors
+          if (grid1_mask(nbr_add(n))) then
+            nbr_dist(n) = one/nbr_dist(n)
+            dist_tot = dist_tot + nbr_dist(n)
+            nbr_mask(n) = .true.
+          else
+            nbr_mask(n) = .false.
+          endif
+        end do
+
+        !***
+        !*** normalize weights and store the link
+        !***
+
+        do n=1,num_neighbors
+          if (nbr_mask(n)) then
+            wgtstmp(1) = nbr_dist(n)/dist_tot
+            call store_link_nbr(nbr_add(n), dst_add, wgtstmp, nmap)
+            grid2_frac(dst_add) = one
+          endif
+        end do
+
+      end do grid_loop1
+
+      deallocate (coslat, coslon, sinlat, sinlon)
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid2 to grid1 if necessary
+!
+!-----------------------------------------------------------------------
+
+      if (num_maps > 1) then
+
+      nmap = 2
+
+      !***
+      !*** compute cos, sin of lat/lon on source grid for distance
+      !*** calculations
+      !***
+
+      allocate (coslat(grid2_size), coslon(grid2_size), &
+                sinlat(grid2_size), sinlon(grid2_size))
+
+      coslat = cos(grid2_center_lat)
+      coslon = cos(grid2_center_lon)
+      sinlat = sin(grid2_center_lat)
+      sinlon = sin(grid2_center_lon)
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop2: do dst_add = 1, grid1_size
+
+        if (.not. grid1_mask(dst_add)) cycle grid_loop2
+
+        coslat_dst = cos(grid1_center_lat(dst_add))
+        coslon_dst = cos(grid1_center_lon(dst_add))
+        sinlat_dst = sin(grid1_center_lat(dst_add))
+        sinlon_dst = sin(grid1_center_lon(dst_add))
+
+        !***
+        !*** find four nearest grid points on source grid and
+        !*** distances to each point
+        !***
+
+        call grid_search_nbr(nbr_add, nbr_dist, &
+                             grid1_center_lat(dst_add), &
+                             grid1_center_lon(dst_add), &
+                             coslat_dst, coslon_dst,  &
+                             sinlat_dst, sinlon_dst, &
+                             bin_addr2, bin_addr1)
+
+        !***
+        !*** compute weights based on inverse distance
+        !*** if mask is false, eliminate those points
+        !***
+
+        dist_tot = zero
+        do n=1,num_neighbors
+          if (grid2_mask(nbr_add(n))) then
+            nbr_dist(n) = one/nbr_dist(n)
+            dist_tot = dist_tot + nbr_dist(n)
+            nbr_mask(n) = .true.
+          else
+            nbr_mask(n) = .false.
+          endif
+        end do
+
+        !***
+        !*** normalize weights and store the link
+        !***
+
+        do n=1,num_neighbors
+          if (nbr_mask(n)) then
+            wgtstmp(1) = nbr_dist(n)/dist_tot
+            call store_link_nbr(dst_add, nbr_add(n), wgtstmp, nmap)
+            grid1_frac(dst_add) = one
+          endif
+        end do
+
+      end do grid_loop2
+
+      deallocate (coslat, coslon, sinlat, sinlon)
+
+      endif
+
+      deallocate(wgtstmp)
+
+!-----------------------------------------------------------------------
+
+      end subroutine remap_distwgt
+
+!***********************************************************************
+
+      subroutine grid_search_nbr(nbr_add, nbr_dist, plat, plon,  &
+                     coslat_dst, coslon_dst, sinlat_dst, sinlon_dst, &
+                     src_bin_add, dst_bin_add)
+
+!-----------------------------------------------------------------------
+!
+!     this routine finds the closest num_neighbor points to a search 
+!     point and computes a distance to each of the neighbors.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(num_neighbors), intent(out) :: &
+              nbr_add  ! address of each of the closest points
+
+      real (kind=dbl_kind), dimension(num_neighbors), intent(out) :: &
+              nbr_dist ! distance to each of the closest points
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(:,:), intent(in) :: &
+              src_bin_add,  & ! search bins for restricting search
+              dst_bin_add   
+
+      real (kind=dbl_kind), intent(in) :: &
+              plat,          & ! latitude  of the search point
+              plon,          & ! longitude of the search point
+              coslat_dst,    & ! cos(lat)  of the search point
+              coslon_dst,    & ! cos(lon)  of the search point
+              sinlat_dst,    & ! sin(lat)  of the search point
+              sinlon_dst    ! sin(lon)  of the search point
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, nmax, nadd, nchk,  & ! dummy indices
+              min_add, max_add, nm1, np1, i, j, ip1, im1, jp1, jm1
+
+      real (kind=dbl_kind) :: &
+              distance      ! angular distance
+
+!-----------------------------------------------------------------------
+!
+!     loop over source grid and find nearest neighbors
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** restrict the search using search bins
+      !*** expand the bins to catch neighbors
+      !***
+
+      select case (restrict_type)
+      case('latitude')
+
+        do n=1,num_srch_bins
+          if (plat >= bin_lats(1,n) .and. plat <= bin_lats(2,n)) then
+            min_add = src_bin_add(1,n)
+            max_add = src_bin_add(2,n)
+
+            nm1 = max(n-1,1)
+            np1 = min(n+1,num_srch_bins)
+
+            min_add = min(min_add,src_bin_add(1,nm1))
+            max_add = max(max_add,src_bin_add(2,nm1))
+            min_add = min(min_add,src_bin_add(1,np1))
+            max_add = max(max_add,src_bin_add(2,np1))
+          endif
+        end do
+
+      case('latlon')
+
+        n = 0
+        nmax = nint(sqrt(real(num_srch_bins)))
+        do j=1,nmax
+        jp1 = min(j+1,nmax)
+        jm1 = max(j-1,1)
+        do i=1,nmax
+          ip1 = min(i+1,nmax)
+          im1 = max(i-1,1)
+
+          n = n+1
+          if (plat >= bin_lats(1,n) .and. plat <= bin_lats(2,n) .and. &
+              plon >= bin_lons(1,n) .and. plon <= bin_lons(3,n)) then
+            min_add = src_bin_add(1,n)
+            max_add = src_bin_add(2,n)
+
+            nm1 = (jm1-1)*nmax + im1
+            np1 = (jp1-1)*nmax + ip1
+            nm1 = max(nm1,1)
+            np1 = min(np1,num_srch_bins)
+
+            min_add = min(min_add,src_bin_add(1,nm1))
+            max_add = max(max_add,src_bin_add(2,nm1))
+            min_add = min(min_add,src_bin_add(1,np1))
+            max_add = max(max_add,src_bin_add(2,np1))
+          endif
+        end do
+        end do
+
+      end select
+
+      !***
+      !*** initialize distance and address arrays
+      !***
+
+      nbr_add = 0
+      nbr_dist = bignum
+
+      do nadd=min_add,max_add
+
+        !***
+        !*** find distance to this point
+        !***
+
+        distance = acos(sinlat_dst*sinlat(nadd) + &
+                        coslat_dst*coslat(nadd)* &
+                       (coslon_dst*coslon(nadd) + &
+                        sinlon_dst*sinlon(nadd)) )
+
+        !***
+        !*** store the address and distance if this is one of the
+        !*** smallest four so far
+        !***
+
+        check_loop: do nchk=1,num_neighbors
+          if (distance .lt. nbr_dist(nchk)) then
+            do n=num_neighbors,nchk+1,-1
+              nbr_add(n) = nbr_add(n-1)
+              nbr_dist(n) = nbr_dist(n-1)
+            end do
+            nbr_add(nchk) = nadd
+            nbr_dist(nchk) = distance
+            exit check_loop
+          endif
+        end do check_loop
+
+      end do
+
+!-----------------------------------------------------------------------
+
+      end subroutine grid_search_nbr 
+
+!***********************************************************************
+
+      subroutine store_link_nbr(add1, add2, weights, nmap)
+
+!-----------------------------------------------------------------------
+!
+!     this routine stores the address and weight for this link in
+!     the appropriate address and weight arrays and resizes those
+!     arrays if necessary.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) :: &
+              add1,   & ! address on grid1
+              add2,   & ! address on grid2
+              nmap   ! identifies which direction for mapping
+
+      real (kind=dbl_kind), dimension(:), intent(in) :: &
+              weights ! array of remapping weights for this link
+
+!-----------------------------------------------------------------------
+!
+!     increment number of links and check to see if remap arrays need
+!     to be increased to accomodate the new link.  then store the
+!     link.
+!
+!-----------------------------------------------------------------------
+
+      select case (nmap)
+      case(1)
+
+        num_links_map1  = num_links_map1 + 1
+
+        if (num_links_map1 > max_links_map1)  &
+           call resize_remap_vars(1,resize_increment)
+
+        grid1_add_map1(num_links_map1) = add1
+        grid2_add_map1(num_links_map1) = add2
+        wts_map1    (:,num_links_map1) = weights
+
+      case(2)
+
+        num_links_map2  = num_links_map2 + 1
+
+        if (num_links_map2 > max_links_map2)  &
+           call resize_remap_vars(2,resize_increment)
+
+        grid1_add_map2(num_links_map2) = add1
+        grid2_add_map2(num_links_map2) = add2
+        wts_map2    (:,num_links_map2) = weights
+
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine store_link_nbr
+
+!***********************************************************************
+
+      end module remap_distance_weight
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/remap_read.f90
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/remap_read.f90	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/remap_read.f90	(revision 2352)
@@ -0,0 +1,1027 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This routine reads remapping information from files written
+!     by remap_setup.  If remapping in both directions are required,
+!     two input files must be specified.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_read.f,v 1.6 2000/04/19 21:56:26 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_read
+
+!-----------------------------------------------------------------------
+!
+!     contains routines for reading a remap file
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines useful constants
+      use grids         ! includes all grid information
+      use netcdf_mod    ! module with netcdf vars and utilities
+      use remap_vars    ! module for all required remapping variables
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!     various netCDF ids for files variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), private ::  & ! netCDF ids
+               ncstat, nc_file_id, &
+               nc_srcgrdsize_id, nc_dstgrdsize_id, &
+               nc_srcgrdcorn_id, nc_dstgrdcorn_id, &
+               nc_srcgrdrank_id, nc_dstgrdrank_id, &
+               nc_srcgrddims_id, nc_dstgrddims_id, &
+               nc_numlinks_id, nc_numwgts_id,  &
+               nc_srcgrdimask_id, nc_dstgrdimask_id, &
+               nc_srcgrdcntrlat_id, nc_srcgrdcntrlon_id, &
+               nc_srcgrdcrnrlat_id, nc_srcgrdcrnrlon_id, &
+               nc_srcgrdarea_id, nc_srcgrdfrac_id, &
+               nc_dstgrdcntrlat_id, nc_dstgrdcntrlon_id, &
+               nc_dstgrdcrnrlat_id, nc_dstgrdcrnrlon_id, &
+               nc_dstgrdarea_id, nc_dstgrdfrac_id, &
+               nc_srcgrdadd_id, nc_dstgrdadd_id, nc_rmpmatrix_id
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine read_remap(map_name, interp_file)
+
+!-----------------------------------------------------------------------
+!
+!     this driver routine reads some global attributes and then
+!     calls a specific read routine based on file conventions
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(in) :: &
+        interp_file        ! filename for remap data
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(out) :: &
+        map_name            ! name for mapping
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len) ::  &
+         map_method        & ! character string for map_type
+      ,  normalize_opt     & ! character string for normalization option
+      ,  convention       ! character string for output convention
+
+!-----------------------------------------------------------------------
+!
+!     open file and read some global information
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_open(interp_file, NF_NOWRITE, nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** map name
+      !***
+      map_name = ' '
+      ncstat = nf_get_att_text(nc_file_id, NF_GLOBAL, 'title', &
+                               map_name)
+      call netcdf_error_handler(ncstat)
+
+      print *,'Reading remapping:',trim(map_name)
+      print *,'From file:',trim(interp_file)
+
+      !***
+      !*** normalization option
+      !***
+      normalize_opt = ' '
+      ncstat = nf_get_att_text(nc_file_id, NF_GLOBAL, 'normalization', &
+                               normalize_opt)
+      call netcdf_error_handler(ncstat)
+
+      select case(normalize_opt)
+      case ('none')
+        norm_opt = norm_opt_none
+      case ('fracarea')
+        norm_opt = norm_opt_frcarea
+      case ('destarea')
+        norm_opt = norm_opt_dstarea
+      case default
+        print *,'normalize_opt = ',normalize_opt
+        stop 'Invalid normalization option'
+      end select
+
+      !***
+      !*** map method
+      !***
+      map_method = ' '
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'map_method', &
+                                map_method)
+      call netcdf_error_handler(ncstat)
+
+      select case(map_method)
+      case('Conservative remapping')
+        map_type = map_type_conserv
+      case('Bilinear remapping')
+        map_type = map_type_bilinear
+      case('Distance weighted avg of nearest neighbors')
+        map_type = map_type_distwgt
+      case('Bicubic remapping')
+        map_type = map_type_bicubic
+      case default
+        print *,'map_type = ',map_method
+        stop 'Invalid Map Type'
+      end select
+
+      !***
+      !*** file convention
+      !***
+      convention = ' '
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'conventions', &
+                                convention)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     call appropriate read routine based on output convention
+!
+!-----------------------------------------------------------------------
+
+      select case(convention)
+      case ('SCRIP')
+        call read_remap_scrip
+      case ('NCAR-CSM')
+        call read_remap_csm
+      case default
+        print *,'convention = ',convention
+        stop 'unknown output file convention'
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine read_remap
+
+!***********************************************************************
+
+      subroutine read_remap_scrip
+
+!-----------------------------------------------------------------------
+!
+!     the routine reads a netCDF file to extract remapping info
+!     in SCRIP format
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character (char_len) :: &
+        grid1_name            & ! grid name for source grid
+      , grid2_name           ! grid name for dest   grid
+
+      integer (kind=int_kind) ::   &
+        n                    ! dummy index
+
+      integer (kind=int_kind), dimension(:), allocatable :: &
+        grid1_mask_int,       & ! integer masks to determine
+        grid2_mask_int       ! cells that participate in map
+
+!-----------------------------------------------------------------------
+!
+!     read some additional global attributes
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** source and destination grid names
+      !***
+
+      grid1_name = ' '
+      grid2_name = ' '
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'source_grid', &
+                                grid1_name)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'dest_grid', &
+                                grid2_name)
+      call netcdf_error_handler(ncstat)
+
+      print *,' '
+      print *,'Remapping between:',trim(grid1_name)
+      print *,'and ',trim(grid2_name)
+      print *,' '
+
+!-----------------------------------------------------------------------
+!
+!     read dimension information
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_inq_dimid(nc_file_id, 'src_grid_size',  &
+                            nc_srcgrdsize_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdsize_id, grid1_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'dst_grid_size',  &
+                            nc_dstgrdsize_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdsize_id, grid2_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'src_grid_corners',  &
+                            nc_srcgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdcorn_id,  &
+                             grid1_corners)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'dst_grid_corners',  &
+                            nc_dstgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdcorn_id,  &
+                             grid2_corners)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'src_grid_rank',  &
+                            nc_srcgrdrank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdrank_id,  &
+                             grid1_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'dst_grid_rank',  &
+                            nc_dstgrdrank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdrank_id,  &
+                             grid2_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'num_links',  &
+                            nc_numlinks_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_numlinks_id,  &
+                             num_links_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'num_wgts',  &
+                            nc_numwgts_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_numwgts_id, num_wts)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     allocate arrays
+!
+!-----------------------------------------------------------------------
+
+      allocate( grid1_dims      (grid1_rank), &
+                grid1_center_lat(grid1_size),  &
+                grid1_center_lon(grid1_size), &
+                grid1_area      (grid1_size), &
+                grid1_frac      (grid1_size), &
+                grid1_mask      (grid1_size), &
+                grid1_mask_int  (grid1_size), &
+                grid1_corner_lat(grid1_corners, grid1_size), &
+                grid1_corner_lon(grid1_corners, grid1_size) )
+
+      allocate( grid2_dims      (grid2_rank), &
+                grid2_center_lat(grid2_size),  &
+                grid2_center_lon(grid2_size), &
+                grid2_area      (grid2_size), &
+                grid2_frac      (grid2_size), &
+                grid2_mask      (grid2_size), &
+                grid2_mask_int  (grid2_size), &
+                grid2_corner_lat(grid2_corners, grid2_size), &
+                grid2_corner_lon(grid2_corners, grid2_size) )
+
+      allocate( grid1_add_map1(num_links_map1), &
+                grid2_add_map1(num_links_map1), &
+                wts_map1(num_wts,num_links_map1) )
+
+!-----------------------------------------------------------------------
+!
+!     get variable ids
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_dims',  &
+                            nc_srcgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_imask',  &
+                            nc_srcgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_center_lat',  &
+                                         nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_center_lon',  &
+                                         nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_corner_lat',  &
+                                         nc_srcgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_corner_lon',  &
+                                         nc_srcgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_area',  &
+                                         nc_srcgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_frac',  &
+                                         nc_srcgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_dims',  &
+                            nc_dstgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_imask',  &
+                            nc_dstgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_center_lat',  &
+                                         nc_dstgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_center_lon',  &
+                                         nc_dstgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_corner_lat',  &
+                                         nc_dstgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_corner_lon',  &
+                                         nc_dstgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_area',  &
+                                         nc_dstgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_frac',  &
+                                         nc_dstgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_address',  &
+                                         nc_srcgrdadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_address',  &
+                                         nc_dstgrdadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'remap_matrix',  &
+                                         nc_rmpmatrix_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     read all variables
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrddims_id,  &
+                              grid1_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrdimask_id,  &
+                              grid1_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcntrlat_id,  &
+                                             grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcntrlon_id,  &
+                                             grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      grid1_units = ' '
+      ncstat = nf_get_att_text(nc_file_id, nc_srcgrdcntrlat_id, 'units', &
+                               grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+        grid1_center_lat = grid1_center_lat*deg2rad
+        grid1_center_lon = grid1_center_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid1 center lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcrnrlat_id,  &
+                                             grid1_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcrnrlon_id,  &
+                                             grid1_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      grid1_units = ' '
+      ncstat = nf_get_att_text(nc_file_id, nc_srcgrdcrnrlat_id, 'units', &
+                               grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+        grid1_corner_lat = grid1_corner_lat*deg2rad
+        grid1_corner_lon = grid1_corner_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid1 corner lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdarea_id,  &
+                                             grid1_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdfrac_id,  &
+                                             grid1_frac)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrddims_id,  &
+                              grid2_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrdimask_id,  &
+                              grid2_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcntrlat_id,  &
+                                             grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcntrlon_id,  &
+                                             grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      grid2_units = ' '
+      ncstat = nf_get_att_text(nc_file_id, nc_dstgrdcntrlat_id, 'units', &
+                               grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+        grid2_center_lat = grid2_center_lat*deg2rad
+        grid2_center_lon = grid2_center_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid2 center lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcrnrlat_id,  &
+                                             grid2_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcrnrlon_id,  &
+                                             grid2_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      grid2_units = ' '
+      ncstat = nf_get_att_text(nc_file_id, nc_dstgrdcrnrlat_id, 'units', &
+                               grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+        grid2_corner_lat = grid2_corner_lat*deg2rad
+        grid2_corner_lon = grid2_corner_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid2 corner lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdarea_id,  &
+                                             grid2_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdfrac_id,  &
+                                             grid2_frac)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrdadd_id,  &
+                              grid1_add_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrdadd_id,  &
+                              grid2_add_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_rmpmatrix_id,  &
+                                             wts_map1)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     initialize logical mask 
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_mask_int == 1)
+        grid1_mask = .true.
+      elsewhere
+        grid1_mask = .false.
+      endwhere
+      where (grid2_mask_int == 1)
+        grid2_mask = .true.
+      elsewhere
+        grid2_mask = .false.
+      endwhere
+      deallocate(grid1_mask_int, grid2_mask_int)
+
+!-----------------------------------------------------------------------
+!
+!     close input file
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_close(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end subroutine read_remap_scrip
+
+!***********************************************************************
+
+      subroutine read_remap_csm
+
+!-----------------------------------------------------------------------
+!
+!     the routine reads a netCDF file to extract remapping info
+!     in NCAR-CSM format
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character (char_len) :: &
+        grid1_name            & ! grid name for source grid
+      , grid2_name           ! grid name for dest   grid
+
+      integer (kind=int_kind) :: &
+        nc_numwgts1_id     & ! extra netCDF id for num_wgts > 1 
+      , nc_rmpmatrix2_id  ! extra netCDF id for high-order remap matrix
+
+      real (kind=dbl_kind), dimension(:),allocatable :: &
+        wts1              ! CSM wants single array for 1st-order wts
+
+      real (kind=dbl_kind), dimension(:,:),allocatable :: &
+        wts2              ! write remaining weights in different array
+
+      integer (kind=int_kind) ::   &
+        n                    ! dummy index
+
+      integer (kind=int_kind), dimension(:), allocatable :: &
+        grid1_mask_int,       & ! integer masks to determine
+        grid2_mask_int       ! cells that participate in map
+
+!-----------------------------------------------------------------------
+!
+!     read some additional global attributes
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** source and destination grid names
+      !***
+
+      grid1_name = ' '
+      grid2_name = ' '
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'domain_a', &
+                                grid1_name)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'domain_b', &
+                                grid2_name)
+      call netcdf_error_handler(ncstat)
+
+      print *,' '
+      print *,'Remapping between:',trim(grid1_name)
+      print *,'and ',trim(grid2_name)
+      print *,' '
+
+!-----------------------------------------------------------------------
+!
+!     read dimension information
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_inq_dimid(nc_file_id, 'n_a', nc_srcgrdsize_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdsize_id, grid1_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'n_b', nc_dstgrdsize_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdsize_id, grid2_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'nv_a', nc_srcgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdcorn_id,  &
+                             grid1_corners)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'nv_b', nc_dstgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdcorn_id,  &
+                             grid2_corners)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'src_grid_rank',  &
+                            nc_srcgrdrank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdrank_id,  &
+                             grid1_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'dst_grid_rank',  &
+                            nc_dstgrdrank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdrank_id,  &
+                             grid2_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'n_s',  &
+                            nc_numlinks_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_numlinks_id,  &
+                             num_links_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'num_wgts',  &
+                            nc_numwgts_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_numwgts_id, num_wts)
+      call netcdf_error_handler(ncstat)
+
+      if (num_wts > 1) then
+        ncstat = nf_inq_dimid(nc_file_id, 'num_wgts1',  &
+                              nc_numwgts1_id)
+        call netcdf_error_handler(ncstat)
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     allocate arrays
+!
+!-----------------------------------------------------------------------
+
+      allocate( grid1_dims      (grid1_rank), &
+                grid1_center_lat(grid1_size),  &
+                grid1_center_lon(grid1_size), &
+                grid1_area      (grid1_size), &
+                grid1_frac      (grid1_size), &
+                grid1_mask      (grid1_size), &
+                grid1_mask_int  (grid1_size), &
+                grid1_corner_lat(grid1_corners, grid1_size), &
+                grid1_corner_lon(grid1_corners, grid1_size) )
+
+      allocate( grid2_dims      (grid2_rank), &
+                grid2_center_lat(grid2_size),  &
+                grid2_center_lon(grid2_size), &
+                grid2_area      (grid2_size), &
+                grid2_frac      (grid2_size), &
+                grid2_mask      (grid2_size), &
+                grid2_mask_int  (grid2_size), &
+                grid2_corner_lat(grid2_corners, grid2_size), &
+                grid2_corner_lon(grid2_corners, grid2_size) )
+
+      allocate( grid1_add_map1(num_links_map1), &
+                grid2_add_map1(num_links_map1), &
+                wts_map1(num_wts,num_links_map1), &
+                wts1(num_links_map1), &
+                wts2(num_wts-1,num_links_map1) )
+
+!-----------------------------------------------------------------------
+!
+!     get variable ids
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_dims',  &
+                            nc_srcgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'mask_a',  &
+                            nc_srcgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'yc_a', nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'xc_a', nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'yv_a', nc_srcgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'xv_a', nc_srcgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'area_a', nc_srcgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'frac_a', nc_srcgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_dims',  &
+                            nc_dstgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'mask_b',  &
+                            nc_dstgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'yc_b', nc_dstgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'xc_b', nc_dstgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'yv_b', nc_dstgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'xv_b', nc_dstgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'area_b', nc_dstgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'frac_b', nc_dstgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'col', nc_srcgrdadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'row', nc_dstgrdadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'S', nc_rmpmatrix_id)
+      call netcdf_error_handler(ncstat)
+
+      if (num_wts > 1) then
+        ncstat = nf_inq_varid(nc_file_id, 'S2', nc_rmpmatrix2_id)
+        call netcdf_error_handler(ncstat)
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     read all variables
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrddims_id,  &
+                              grid1_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrdimask_id,  &
+                              grid1_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcntrlat_id,  &
+                                             grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcntrlon_id,  &
+                                             grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text(nc_file_id, nc_srcgrdcntrlat_id, 'units', &
+                               grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+        grid1_center_lat = grid1_center_lat*deg2rad
+        grid1_center_lon = grid1_center_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid1 center lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcrnrlat_id,  &
+                                             grid1_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcrnrlon_id,  &
+                                             grid1_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text(nc_file_id, nc_srcgrdcrnrlat_id, 'units', &
+                               grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+        grid1_corner_lat = grid1_corner_lat*deg2rad
+        grid1_corner_lon = grid1_corner_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid1 corner lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdarea_id,  &
+                                             grid1_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdfrac_id,  &
+                                             grid1_frac)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrddims_id,  &
+                              grid2_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrdimask_id,  &
+                              grid2_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcntrlat_id,  &
+                                             grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcntrlon_id,  &
+                                             grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text(nc_file_id, nc_dstgrdcntrlat_id, 'units', &
+                               grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+        grid2_center_lat = grid2_center_lat*deg2rad
+        grid2_center_lon = grid2_center_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid2 center lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcrnrlat_id,  &
+                                             grid2_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcrnrlon_id,  &
+                                             grid2_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+
+      ncstat = nf_get_att_text(nc_file_id, nc_dstgrdcrnrlat_id, 'units', &
+                               grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+        grid2_corner_lat = grid2_corner_lat*deg2rad
+        grid2_corner_lon = grid2_corner_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid2 corner lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdarea_id,  &
+                                             grid2_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdfrac_id,  &
+                                             grid2_frac)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrdadd_id,  &
+                              grid1_add_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrdadd_id,  &
+                              grid2_add_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_rmpmatrix_id,  &
+                                             wts1)
+      wts_map1(1,:) = wts1
+      deallocate(wts1)
+
+      if (num_wts > 1) then
+        ncstat = nf_get_var_double(nc_file_id, nc_rmpmatrix2_id,  &
+                                               wts2)
+        wts_map1(2:,:) = wts2
+        deallocate(wts2)
+      endif
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     initialize logical mask 
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_mask_int == 1)
+        grid1_mask = .true.
+      elsewhere
+        grid1_mask = .false.
+      endwhere
+      where (grid2_mask_int == 1)
+        grid2_mask = .true.
+      elsewhere
+        grid2_mask = .false.
+      endwhere
+      deallocate(grid1_mask_int, grid2_mask_int)
+
+!-----------------------------------------------------------------------
+!
+!     close input file
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_close(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end subroutine read_remap_csm
+
+!***********************************************************************
+
+      end module remap_read
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/remap_vars.f90
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/remap_vars.f90	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/remap_vars.f90	(revision 2352)
@@ -0,0 +1,302 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary variables for remapping between
+!     two grids.  also routines for resizing and initializing these
+!     variables.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_vars.f,v 1.5 2000/04/19 21:56:26 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_vars
+
+      use kinds_mod
+      use constants
+      use grids
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter :: &
+            norm_opt_none    = 1 &
+      ,     norm_opt_dstarea = 2 &
+      ,     norm_opt_frcarea = 3
+
+      integer (kind=int_kind), parameter :: &
+            map_type_conserv  = 1 &
+      ,     map_type_bilinear = 2 &
+      ,     map_type_bicubic  = 3 &
+      ,     map_type_distwgt  = 4
+
+      integer (kind=int_kind), save ::  &
+            max_links_map1   & ! current size of link arrays
+      ,     num_links_map1   & ! actual number of links for remapping
+      ,     max_links_map2   & ! current size of link arrays
+      ,     num_links_map2   & ! actual number of links for remapping
+      ,     num_maps         & ! num of remappings for this grid pair
+      ,     num_wts          & ! num of weights used in remapping
+      ,     map_type         & ! identifier for remapping method
+      ,     norm_opt         & ! option for normalization (conserv only)
+      ,     resize_increment ! default amount to increase array size
+
+      integer (kind=int_kind), dimension(:), allocatable, save :: &
+            grid1_add_map1,  & ! grid1 address for each link in mapping 1
+            grid2_add_map1,  & ! grid2 address for each link in mapping 1
+            grid1_add_map2,  & ! grid1 address for each link in mapping 2
+            grid2_add_map2  ! grid2 address for each link in mapping 2
+
+      real (kind=dbl_kind), dimension(:,:), allocatable, save :: &
+            wts_map1,  & ! map weights for each link (num_wts,max_links)
+            wts_map2  ! map weights for each link (num_wts,max_links)
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine init_remap_vars
+
+!-----------------------------------------------------------------------
+!
+!     this routine initializes some variables and provides an initial
+!     allocation of arrays (fairly large so frequent resizing 
+!     unnecessary).
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     determine the number of weights
+!
+!-----------------------------------------------------------------------
+
+      select case (map_type)
+      case(map_type_conserv)
+        num_wts = 3
+      case(map_type_bilinear)
+        num_wts = 1
+      case(map_type_bicubic)
+        num_wts = 4
+      case(map_type_distwgt)
+        num_wts = 1
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     initialize num_links and set max_links to four times the largest 
+!     of the destination grid sizes initially (can be changed later).
+!     set a default resize increment to increase the size of link
+!     arrays if the number of links exceeds the initial size
+!   
+!-----------------------------------------------------------------------
+
+      num_links_map1 = 0
+      max_links_map1 = 4*grid2_size
+      if (num_maps > 1) then
+        num_links_map2 = 0
+        max_links_map1 = max(4*grid1_size,4*grid2_size)
+        max_links_map2 = max_links_map1
+      endif
+
+      resize_increment = 0.1*max(grid1_size,grid2_size)
+
+!-----------------------------------------------------------------------
+!
+!     allocate address and weight arrays for mapping 1
+!   
+!-----------------------------------------------------------------------
+
+      allocate (grid1_add_map1(max_links_map1), &
+                grid2_add_map1(max_links_map1), &
+                wts_map1(num_wts, max_links_map1))
+
+!-----------------------------------------------------------------------
+!
+!     allocate address and weight arrays for mapping 2 if necessary 
+!   
+!-----------------------------------------------------------------------
+
+      if (num_maps > 1) then
+        allocate (grid1_add_map2(max_links_map2), &
+                  grid2_add_map2(max_links_map2), &
+                  wts_map2(num_wts, max_links_map2))
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine init_remap_vars
+
+!***********************************************************************
+
+      subroutine resize_remap_vars(nmap, increment)
+
+!-----------------------------------------------------------------------
+!
+!     this routine resizes remapping arrays by increasing(decreasing)
+!     the max_links by increment
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) :: &
+           nmap,       & ! identifies which mapping array to resize
+           increment  ! the number of links to add(subtract) to arrays
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: &
+         ierr,      & ! error flag
+         mxlinks   ! size of link arrays
+
+      integer (kind=int_kind), dimension(:), allocatable :: &
+         add1_tmp,  & ! temp array for resizing address arrays
+         add2_tmp  ! temp array for resizing address arrays
+
+      real (kind=dbl_kind), dimension(:,:), allocatable :: &
+         wts_tmp   ! temp array for resizing weight arrays
+
+!-----------------------------------------------------------------------
+!
+!     resize map 1 arrays if required.
+!
+!-----------------------------------------------------------------------
+
+      select case (nmap)
+      case(1)
+
+        !***
+        !*** allocate temporaries to hold original values
+        !***
+
+        mxlinks = size(grid1_add_map1)
+        allocate (add1_tmp(mxlinks), add2_tmp(mxlinks),  &
+                  wts_tmp(num_wts,mxlinks))
+
+        add1_tmp = grid1_add_map1
+        add2_tmp = grid2_add_map1
+        wts_tmp  = wts_map1
+        
+        !***
+        !*** deallocate originals and increment max_links then
+        !*** reallocate arrays at new size
+        !***
+
+        deallocate (grid1_add_map1, grid2_add_map1, wts_map1)
+        max_links_map1 = mxlinks + increment
+        allocate (grid1_add_map1(max_links_map1), &
+                  grid2_add_map1(max_links_map1), &
+                  wts_map1(num_wts,max_links_map1))
+
+        !***
+        !*** restore original values from temp arrays and
+        !*** deallocate temps
+        !***
+
+        mxlinks = min(mxlinks, max_links_map1)
+        grid1_add_map1(1:mxlinks) = add1_tmp (1:mxlinks)
+        grid2_add_map1(1:mxlinks) = add2_tmp (1:mxlinks)
+        wts_map1    (:,1:mxlinks) = wts_tmp(:,1:mxlinks)
+        deallocate(add1_tmp, add2_tmp, wts_tmp)
+
+!-----------------------------------------------------------------------
+!
+!     resize map 2 arrays if required.
+!
+!-----------------------------------------------------------------------
+
+      case(2)
+
+        !***
+        !*** allocate temporaries to hold original values
+        !***
+
+        mxlinks = size(grid1_add_map2)
+        allocate (add1_tmp(mxlinks), add2_tmp(mxlinks),  &
+                  wts_tmp(num_wts,mxlinks),stat=ierr)
+        if (ierr .ne. 0) then
+          print *,'error allocating temps in resize: ',ierr
+          stop
+        endif
+
+        add1_tmp = grid1_add_map2
+        add2_tmp = grid2_add_map2
+        wts_tmp  = wts_map2
+        
+        !***
+        !*** deallocate originals and increment max_links then
+        !*** reallocate arrays at new size
+        !***
+
+        deallocate (grid1_add_map2, grid2_add_map2, wts_map2)
+        max_links_map2 = mxlinks + increment
+        allocate (grid1_add_map2(max_links_map2), &
+                  grid2_add_map2(max_links_map2), &
+                  wts_map2(num_wts,max_links_map2),stat=ierr)
+        if (ierr .ne. 0) then
+          print *,'error allocating new arrays in resize: ',ierr
+          stop
+        endif
+
+
+        !***
+        !*** restore original values from temp arrays and
+        !*** deallocate temps
+        !***
+
+        mxlinks = min(mxlinks, max_links_map2)
+        grid1_add_map2(1:mxlinks) = add1_tmp (1:mxlinks)
+        grid2_add_map2(1:mxlinks) = add2_tmp (1:mxlinks)
+        wts_map2    (:,1:mxlinks) = wts_tmp(:,1:mxlinks)
+        deallocate(add1_tmp, add2_tmp, wts_tmp)
+
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine resize_remap_vars
+
+!***********************************************************************
+
+      end module remap_vars
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/remap_write.f90
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/remap_write.f90	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/remap_write.f90	(revision 2352)
@@ -0,0 +1,1763 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module contains routines for writing the remapping data to 
+!     a file.  Before writing the data for each mapping, the links are 
+!     sorted by destination grid address.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_write.f,v 1.7 2001/08/21 21:06:42 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_write
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common scalar constants
+      use grids         ! module containing grid information
+      use remap_vars    ! module containing remap information
+      use netcdf_mod    ! module with netCDF stuff
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), private ::  &
+         map_method        & ! character string for map_type
+      ,  normalize_opt     & ! character string for normalization option
+      ,  history           & ! character string for history information
+      ,  convention       ! character string for output convention
+
+      character(8), private ::  &
+         cdate            ! character date string
+
+      integer (kind=int_kind), dimension(:), allocatable, private :: &
+         src_mask_int      & ! integer masks to determine
+      ,  dst_mask_int     ! cells that participate in map
+
+!-----------------------------------------------------------------------
+!
+!     various netCDF identifiers used by output routines
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), private :: &
+         ncstat                & ! error flag for netCDF calls 
+      ,  nc_file_id            & ! id for netCDF file
+      ,  nc_srcgrdsize_id      & ! id for source grid size
+      ,  nc_dstgrdsize_id      & ! id for destination grid size
+      ,  nc_srcgrdcorn_id      & ! id for number of source grid corners
+      ,  nc_dstgrdcorn_id      & ! id for number of dest grid corners
+      ,  nc_srcgrdrank_id      & ! id for source grid rank
+      ,  nc_dstgrdrank_id      & ! id for dest grid rank
+      ,  nc_numlinks_id        & ! id for number of links in mapping
+      ,  nc_numwgts_id         & ! id for number of weights for mapping
+      ,  nc_srcgrddims_id      & ! id for source grid dimensions
+      ,  nc_dstgrddims_id      & ! id for dest grid dimensions
+      ,  nc_srcgrdcntrlat_id   & ! id for source grid center latitude
+      ,  nc_dstgrdcntrlat_id   & ! id for dest grid center latitude
+      ,  nc_srcgrdcntrlon_id   & ! id for source grid center longitude
+      ,  nc_dstgrdcntrlon_id   & ! id for dest grid center longitude
+      ,  nc_srcgrdimask_id     & ! id for source grid mask
+      ,  nc_dstgrdimask_id     & ! id for dest grid mask
+      ,  nc_srcgrdcrnrlat_id   & ! id for latitude of source grid corners
+      ,  nc_srcgrdcrnrlon_id   & ! id for longitude of source grid corners
+      ,  nc_dstgrdcrnrlat_id   & ! id for latitude of dest grid corners
+      ,  nc_dstgrdcrnrlon_id   & ! id for longitude of dest grid corners
+      ,  nc_srcgrdarea_id      & ! id for area of source grid cells
+      ,  nc_dstgrdarea_id      & ! id for area of dest grid cells
+      ,  nc_srcgrdfrac_id      & ! id for area fraction on source grid
+      ,  nc_dstgrdfrac_id      & ! id for area fraction on dest grid
+      ,  nc_srcadd_id          & ! id for map source address
+      ,  nc_dstadd_id          & ! id for map destination address
+      ,  nc_rmpmatrix_id      ! id for remapping matrix
+
+      integer (kind=int_kind), dimension(2), private :: &
+         nc_dims2_id  ! netCDF ids for 2d array dims
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine write_remap(map1_name, map2_name,  &
+                             interp_file1, interp_file2, output_opt)
+
+!-----------------------------------------------------------------------
+!
+!     calls correct output routine based on output format choice
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(in) :: &
+                  map1_name,     & ! name for mapping grid1 to grid2
+                  map2_name,     & ! name for mapping grid2 to grid1
+                  interp_file1,  & ! filename for map1 remap data
+                  interp_file2,  & ! filename for map2 remap data
+                  output_opt    ! option for output conventions
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     define some common variables to be used in all routines
+!
+!-----------------------------------------------------------------------
+
+      select case(norm_opt)
+      case (norm_opt_none)
+        normalize_opt = 'none'
+      case (norm_opt_frcarea)
+        normalize_opt = 'fracarea'
+      case (norm_opt_dstarea)
+        normalize_opt = 'destarea'
+      end select
+
+      select case(map_type)
+      case(map_type_conserv)
+        map_method = 'Conservative remapping'
+      case(map_type_bilinear)
+        map_method = 'Bilinear remapping'
+      case(map_type_distwgt)
+        map_method = 'Distance weighted avg of nearest neighbors'
+      case(map_type_bicubic)
+        map_method = 'Bicubic remapping'
+      case default
+        stop 'Invalid Map Type'
+      end select
+
+      call date_and_time(date=cdate)
+      write (history,1000) cdate(5:6),cdate(7:8),cdate(1:4)
+ 1000 format('Created: ',a2,'-',a2,'-',a4)
+
+!-----------------------------------------------------------------------
+!
+!     sort address and weight arrays
+!
+!-----------------------------------------------------------------------
+
+      call sort_add(grid2_add_map1, grid1_add_map1, wts_map1)
+      if (num_maps > 1) then
+        call sort_add(grid1_add_map2, grid2_add_map2, wts_map2)
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     call appropriate output routine
+!
+!-----------------------------------------------------------------------
+
+      select case(output_opt)
+      case ('scrip')
+        call write_remap_scrip(map1_name, interp_file1, 1)
+      case ('ncar-csm')
+        call write_remap_csm  (map1_name, interp_file1, 1)
+      case default
+        stop 'unknown output file convention'
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     call appropriate output routine for second mapping if required
+!
+!-----------------------------------------------------------------------
+
+      if (num_maps > 1) then
+        select case(output_opt)
+        case ('scrip')
+          call write_remap_scrip(map2_name, interp_file2, 2)
+        case ('ncar-csm')
+          call write_remap_csm  (map2_name, interp_file2, 2)
+        case default
+          stop 'unknown output file convention'
+        end select
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine write_remap
+
+!***********************************************************************
+
+      subroutine write_remap_scrip(map_name, interp_file, direction)
+
+!-----------------------------------------------------------------------
+!
+!     writes remap data to a netCDF file using SCRIP conventions
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(in) :: &
+                  map_name      & ! name for mapping 
+      ,           interp_file  ! filename for remap data
+
+      integer (kind=int_kind), intent(in) :: &
+        direction              ! direction of map (1=grid1 to grid2
+                               !                   2=grid2 to grid1)
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len) :: &
+        grid1_ctmp         & ! character temp for grid1 names
+      , grid2_ctmp        ! character temp for grid2 names
+
+      integer (kind=int_kind) :: &
+        itmp1              & ! integer temp
+      , itmp2              & ! integer temp
+      , itmp3              & ! integer temp
+      , itmp4             ! integer temp
+
+!-----------------------------------------------------------------------
+!
+!     create netCDF file for mapping and define some global attributes
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_create (interp_file, NF_CLOBBER, nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** map name
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'title', &
+                                len_trim(map_name), map_name)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** normalization option
+      !***
+      ncstat = nf_put_att_text(nc_file_id, NF_GLOBAL, 'normalization', &
+                               len_trim(normalize_opt), normalize_opt)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** map method
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'map_method', &
+                                len_trim(map_method), map_method)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** history
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'history', &
+                                len_trim(history), history)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** file convention
+      !***
+      convention = 'SCRIP'
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'conventions', &
+                                len_trim(convention), convention)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** source and destination grid names
+      !***
+
+      if (direction == 1) then
+        grid1_ctmp = 'source_grid'
+        grid2_ctmp = 'dest_grid'
+      else
+        grid1_ctmp = 'dest_grid'
+        grid2_ctmp = 'source_grid'
+      endif
+
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, trim(grid1_ctmp), &
+                                len_trim(grid1_name), grid1_name)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, trim(grid2_ctmp), &
+                                len_trim(grid2_name), grid2_name)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     prepare netCDF dimension info
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** define grid size dimensions
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_size
+        itmp2 = grid2_size
+      else
+        itmp1 = grid2_size
+        itmp2 = grid1_size
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'src_grid_size', itmp1,  &
+                           nc_srcgrdsize_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'dst_grid_size', itmp2,  &
+                           nc_dstgrdsize_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner dimension
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_corners
+        itmp2 = grid2_corners
+      else
+        itmp1 = grid2_corners
+        itmp2 = grid1_corners
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'src_grid_corners',  &
+                           itmp1, nc_srcgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'dst_grid_corners',  &
+                           itmp2, nc_dstgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid rank dimension
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_rank
+        itmp2 = grid2_rank
+      else
+        itmp1 = grid2_rank
+        itmp2 = grid1_rank
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'src_grid_rank',  &
+                           itmp1, nc_srcgrdrank_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'dst_grid_rank',  &
+                           itmp2, nc_dstgrdrank_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define map size dimensions
+      !***
+
+      if (direction == 1) then
+        itmp1 = num_links_map1
+      else
+        itmp1 = num_links_map2
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'num_links',  &
+                           itmp1, nc_numlinks_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'num_wgts',  &
+                           num_wts, nc_numwgts_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid dimensions
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_dims', NF_INT, &
+                           1, nc_srcgrdrank_id, nc_srcgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_dims', NF_INT, &
+                           1, nc_dstgrdrank_id, nc_dstgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     define all arrays for netCDF descriptors
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** define grid center latitude array
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_center_lat',  &
+                           NF_DOUBLE, 1, nc_srcgrdsize_id,  &
+                           nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_center_lat',  &
+                           NF_DOUBLE, 1, nc_dstgrdsize_id,  &
+                           nc_dstgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center longitude array
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_center_lon',  &
+                           NF_DOUBLE, 1, nc_srcgrdsize_id,  &
+                           nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_center_lon',  &
+                           NF_DOUBLE, 1, nc_dstgrdsize_id,  &
+                           nc_dstgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner lat/lon arrays
+      !***
+
+      nc_dims2_id(1) = nc_srcgrdcorn_id
+      nc_dims2_id(2) = nc_srcgrdsize_id
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_corner_lat',  &
+                           NF_DOUBLE, 2, nc_dims2_id,  &
+                           nc_srcgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_corner_lon',  &
+                           NF_DOUBLE, 2, nc_dims2_id,  &
+                           nc_srcgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      nc_dims2_id(1) = nc_dstgrdcorn_id
+      nc_dims2_id(2) = nc_dstgrdsize_id
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_corner_lat',  &
+                           NF_DOUBLE, 2, nc_dims2_id,  &
+                           nc_dstgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_corner_lon',  &
+                           NF_DOUBLE, 2, nc_dims2_id,  &
+                           nc_dstgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define units for all coordinate arrays
+      !***
+
+      if (direction == 1) then
+        grid1_ctmp = grid1_units
+        grid2_ctmp = grid2_units
+      else
+        grid1_ctmp = grid2_units
+        grid2_ctmp = grid1_units
+      endif
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcntrlat_id,  &
+                                'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcntrlat_id,  &
+                                'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcntrlon_id,  &
+                                'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcntrlon_id,  &
+                                'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcrnrlat_id,  &
+                                'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcrnrlon_id,  &
+                                'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcrnrlat_id,  &
+                                'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcrnrlon_id,  &
+                                'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid mask
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_imask', NF_INT, &
+                           1, nc_srcgrdsize_id, nc_srcgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdimask_id,  &
+                                'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_imask', NF_INT, &
+                           1, nc_dstgrdsize_id, nc_dstgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdimask_id,  &
+                                'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid area arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_area',  &
+                           NF_DOUBLE, 1, nc_srcgrdsize_id,  &
+                           nc_srcgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdarea_id,  &
+                                'units', 14, 'square radians')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_area',  &
+                           NF_DOUBLE, 1, nc_dstgrdsize_id,  &
+                           nc_dstgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdarea_id,  &
+                                'units', 14, 'square radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid fraction arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_frac',  &
+                           NF_DOUBLE, 1, nc_srcgrdsize_id,  &
+                           nc_srcgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdfrac_id,  &
+                                'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_frac',  &
+                           NF_DOUBLE, 1, nc_dstgrdsize_id,  &
+                           nc_dstgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdfrac_id,  &
+                                'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define mapping arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_address',  &
+                           NF_INT, 1, nc_numlinks_id,  &
+                           nc_srcadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_address',  &
+                           NF_INT, 1, nc_numlinks_id,  &
+                           nc_dstadd_id)
+      call netcdf_error_handler(ncstat)
+
+      nc_dims2_id(1) = nc_numwgts_id
+      nc_dims2_id(2) = nc_numlinks_id
+
+      ncstat = nf_def_var (nc_file_id, 'remap_matrix',  &
+                           NF_DOUBLE, 2, nc_dims2_id,  &
+                           nc_rmpmatrix_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** end definition stage
+      !***
+
+      ncstat = nf_enddef(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     compute integer masks
+!
+!-----------------------------------------------------------------------
+
+      if (direction == 1) then
+        allocate (src_mask_int(grid1_size), &
+                  dst_mask_int(grid2_size))
+
+        where (grid2_mask)
+          dst_mask_int = 1
+        elsewhere
+          dst_mask_int = 0
+        endwhere
+
+        where (grid1_mask)
+          src_mask_int = 1
+        elsewhere
+          src_mask_int = 0
+        endwhere
+      else
+        allocate (src_mask_int(grid2_size), &
+                  dst_mask_int(grid1_size))
+
+        where (grid1_mask)
+          dst_mask_int = 1
+        elsewhere
+          dst_mask_int = 0
+        endwhere
+
+        where (grid2_mask)
+          src_mask_int = 1
+        elsewhere
+          src_mask_int = 0
+        endwhere
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     change units of lat/lon coordinates if input units different
+!     from radians
+!
+!-----------------------------------------------------------------------
+
+      if (grid1_units(1:7) == 'degrees' .and. direction == 1) then
+        grid1_center_lat = grid1_center_lat/deg2rad
+        grid1_center_lon = grid1_center_lon/deg2rad
+        grid1_corner_lat = grid1_corner_lat/deg2rad
+        grid1_corner_lon = grid1_corner_lon/deg2rad
+      endif
+
+      if (grid2_units(1:7) == 'degrees' .and. direction == 1) then
+        grid2_center_lat = grid2_center_lat/deg2rad
+        grid2_center_lon = grid2_center_lon/deg2rad
+        grid2_corner_lat = grid2_corner_lat/deg2rad
+        grid2_corner_lon = grid2_corner_lon/deg2rad
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     write mapping data
+!
+!-----------------------------------------------------------------------
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrddims_id
+        itmp2 = nc_dstgrddims_id
+      else
+        itmp2 = nc_srcgrddims_id
+        itmp1 = nc_dstgrddims_id
+      endif
+
+      ncstat = nf_put_var_int(nc_file_id, itmp1, grid1_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, itmp2, grid2_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, nc_srcgrdimask_id,  &
+                              src_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, nc_dstgrdimask_id, &
+                              dst_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      deallocate(src_mask_int, dst_mask_int)
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrdcntrlat_id
+        itmp2 = nc_srcgrdcntrlon_id
+        itmp3 = nc_srcgrdcrnrlat_id
+        itmp4 = nc_srcgrdcrnrlon_id
+      else
+        itmp1 = nc_dstgrdcntrlat_id
+        itmp2 = nc_dstgrdcntrlon_id
+        itmp3 = nc_dstgrdcrnrlat_id
+        itmp4 = nc_dstgrdcrnrlon_id
+      endif
+
+      ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp3, grid1_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid1_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        itmp1 = nc_dstgrdcntrlat_id
+        itmp2 = nc_dstgrdcntrlon_id
+        itmp3 = nc_dstgrdcrnrlat_id
+        itmp4 = nc_dstgrdcrnrlon_id
+      else
+        itmp1 = nc_srcgrdcntrlat_id
+        itmp2 = nc_srcgrdcntrlon_id
+        itmp3 = nc_srcgrdcrnrlat_id
+        itmp4 = nc_srcgrdcrnrlon_id
+      endif
+
+      ncstat = nf_put_var_double(nc_file_id, itmp1, grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid2_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrdarea_id
+        itmp2 = nc_srcgrdfrac_id
+        itmp3 = nc_dstgrdarea_id
+        itmp4 = nc_dstgrdfrac_id
+      else
+        itmp1 = nc_dstgrdarea_id
+        itmp2 = nc_dstgrdfrac_id
+        itmp3 = nc_srcgrdarea_id
+        itmp4 = nc_srcgrdfrac_id
+      endif
+
+      if (luse_grid1_area) then
+        ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_area_in)
+      else
+        ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_area)
+      endif
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid1_frac)
+      call netcdf_error_handler(ncstat)
+
+      if (luse_grid2_area) then
+        ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_area_in)
+      else
+        ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_area)
+      endif
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid2_frac)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        ncstat = nf_put_var_int(nc_file_id, nc_srcadd_id,  &
+                                grid1_add_map1)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_int(nc_file_id, nc_dstadd_id,  &
+                                grid2_add_map1)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id,  &
+                                   wts_map1)
+        call netcdf_error_handler(ncstat)
+      else
+        ncstat = nf_put_var_int(nc_file_id, nc_srcadd_id,  &
+                                grid2_add_map2)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_int(nc_file_id, nc_dstadd_id,  &
+                                grid1_add_map2)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id,  &
+                                   wts_map2)
+        call netcdf_error_handler(ncstat)
+      endif
+
+      ncstat = nf_close(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end subroutine write_remap_scrip
+
+!***********************************************************************
+
+      subroutine write_remap_csm(map_name, interp_file, direction)
+
+!-----------------------------------------------------------------------
+!
+!     writes remap data to a netCDF file using NCAR-CSM conventions
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(in) :: &
+                  map_name      & ! name for mapping 
+      ,           interp_file  ! filename for remap data
+
+      integer (kind=int_kind), intent(in) :: &
+        direction              ! direction of map (1=grid1 to grid2
+                               !                   2=grid2 to grid1)
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len) :: &
+        grid1_ctmp         & ! character temp for grid1 names
+      , grid2_ctmp        ! character temp for grid2 names
+
+      integer (kind=int_kind) :: &
+        itmp1              & ! integer temp
+      , itmp2              & ! integer temp
+      , itmp3              & ! integer temp
+      , itmp4              & ! integer temp
+      , nc_numwgts1_id     & ! extra netCDF id for additional weights
+      , nc_src_isize_id    & ! extra netCDF id for ni_a
+      , nc_src_jsize_id    & ! extra netCDF id for nj_a
+      , nc_dst_isize_id    & ! extra netCDF id for ni_b
+      , nc_dst_jsize_id    & ! extra netCDF id for nj_b
+      , nc_rmpmatrix2_id  ! extra netCDF id for high-order remap matrix
+
+      real (kind=dbl_kind), dimension(:),allocatable :: &
+        wts1              ! CSM wants single array for 1st-order wts
+
+      real (kind=dbl_kind), dimension(:,:),allocatable :: &
+        wts2              ! write remaining weights in different array
+
+!-----------------------------------------------------------------------
+!
+!     create netCDF file for mapping and define some global attributes
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_create (interp_file, NF_CLOBBER, nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** map name
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'title', &
+                                len_trim(map_name), map_name)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** normalization option
+      !***
+      ncstat = nf_put_att_text(nc_file_id, NF_GLOBAL, 'normalization', &
+                               len_trim(normalize_opt), normalize_opt)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** map method
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'map_method', &
+                                len_trim(map_method), map_method)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** history
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'history', &
+                                len_trim(history), history)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** file convention
+      !***
+      convention = 'NCAR-CSM'
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'conventions', &
+                                len_trim(convention), convention)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** source and destination grid names
+      !***
+
+      if (direction == 1) then
+        grid1_ctmp = 'domain_a'
+        grid2_ctmp = 'domain_b'
+      else
+        grid1_ctmp = 'domain_b'
+        grid2_ctmp = 'domain_a'
+      endif
+
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, trim(grid1_ctmp), &
+                                len_trim(grid1_name), grid1_name)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, trim(grid2_ctmp), &
+                                len_trim(grid2_name), grid2_name)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     prepare netCDF dimension info
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** define grid size dimensions
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_size
+        itmp2 = grid2_size
+      else
+        itmp1 = grid2_size
+        itmp2 = grid1_size
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'n_a', itmp1, nc_srcgrdsize_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'n_b', itmp2, nc_dstgrdsize_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner dimension
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_corners
+        itmp2 = grid2_corners
+      else
+        itmp1 = grid2_corners
+        itmp2 = grid1_corners
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'nv_a', itmp1, nc_srcgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'nv_b', itmp2, nc_dstgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid rank dimension
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_rank
+        itmp2 = grid2_rank
+      else
+        itmp1 = grid2_rank
+        itmp2 = grid1_rank
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'src_grid_rank',  &
+                           itmp1, nc_srcgrdrank_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'dst_grid_rank',  &
+                           itmp2, nc_dstgrdrank_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define first two dims as if 2-d cartesian domain
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_dims(1)
+        if (grid1_rank > 1) then
+          itmp2 = grid1_dims(2)
+        else
+          itmp2 = 0
+        endif
+        itmp3 = grid2_dims(1)
+        if (grid2_rank > 1) then
+          itmp4 = grid2_dims(2)
+        else
+          itmp4 = 0
+        endif
+      else
+        itmp1 = grid2_dims(1)
+        if (grid2_rank > 1) then
+          itmp2 = grid2_dims(2)
+        else
+          itmp2 = 0
+        endif
+        itmp3 = grid1_dims(1)
+        if (grid1_rank > 1) then
+          itmp4 = grid1_dims(2)
+        else
+          itmp4 = 0
+        endif
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'ni_a', itmp1, nc_src_isize_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'nj_a', itmp2, nc_src_jsize_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'ni_b', itmp3, nc_dst_isize_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'nj_b', itmp4, nc_dst_jsize_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define map size dimensions
+      !***
+
+      if (direction == 1) then
+        itmp1 = num_links_map1
+      else
+        itmp1 = num_links_map2
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'n_s', itmp1, nc_numlinks_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'num_wgts',  &
+                           num_wts, nc_numwgts_id)
+      call netcdf_error_handler(ncstat)
+
+      if (num_wts > 1) then
+        ncstat = nf_def_dim (nc_file_id, 'num_wgts1',  &
+                             num_wts-1, nc_numwgts1_id)
+        call netcdf_error_handler(ncstat)
+      endif
+
+      !***
+      !*** define grid dimensions
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_dims', NF_INT, &
+                           1, nc_srcgrdrank_id, nc_srcgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_dims', NF_INT, &
+                           1, nc_dstgrdrank_id, nc_dstgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     define all arrays for netCDF descriptors
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** define grid center latitude array
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'yc_a', &
+                           NF_DOUBLE, 1, nc_srcgrdsize_id,  &
+                           nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'yc_b',  &
+                           NF_DOUBLE, 1, nc_dstgrdsize_id,  &
+                           nc_dstgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center longitude array
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'xc_a',  &
+                           NF_DOUBLE, 1, nc_srcgrdsize_id,  &
+                           nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'xc_b',  &
+                           NF_DOUBLE, 1, nc_dstgrdsize_id,  &
+                           nc_dstgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner lat/lon arrays
+      !***
+
+      nc_dims2_id(1) = nc_srcgrdcorn_id
+      nc_dims2_id(2) = nc_srcgrdsize_id
+
+      ncstat = nf_def_var (nc_file_id, 'yv_a',  &
+                           NF_DOUBLE, 2, nc_dims2_id,  &
+                           nc_srcgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'xv_a',  &
+                           NF_DOUBLE, 2, nc_dims2_id,  &
+                           nc_srcgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      nc_dims2_id(1) = nc_dstgrdcorn_id
+      nc_dims2_id(2) = nc_dstgrdsize_id
+
+      ncstat = nf_def_var (nc_file_id, 'yv_b',  &
+                           NF_DOUBLE, 2, nc_dims2_id,  &
+                           nc_dstgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'xv_b',  &
+                           NF_DOUBLE, 2, nc_dims2_id,  &
+                           nc_dstgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** CSM wants all in degrees
+      !***
+
+      grid1_units = 'degrees'
+      grid2_units = 'degrees'
+
+      if (direction == 1) then
+        grid1_ctmp = grid1_units
+        grid2_ctmp = grid2_units
+      else
+        grid1_ctmp = grid2_units
+        grid2_ctmp = grid1_units
+      endif
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcntrlat_id,  &
+                                'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcntrlat_id,  &
+                                'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcntrlon_id,  &
+                                'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcntrlon_id,  &
+                                'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcrnrlat_id,  &
+                                'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcrnrlon_id,  &
+                                'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcrnrlat_id,  &
+                                'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcrnrlon_id,  &
+                                'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid mask
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'mask_a', NF_INT, &
+                           1, nc_srcgrdsize_id, nc_srcgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdimask_id,  &
+                                'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'mask_b', NF_INT, &
+                           1, nc_dstgrdsize_id, nc_dstgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdimask_id,  &
+                                'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid area arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'area_a',  &
+                           NF_DOUBLE, 1, nc_srcgrdsize_id,  &
+                           nc_srcgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdarea_id,  &
+                                'units', 14, 'square radians')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'area_b',  &
+                           NF_DOUBLE, 1, nc_dstgrdsize_id,  &
+                           nc_dstgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdarea_id,  &
+                                'units', 14, 'square radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid fraction arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'frac_a',  &
+                           NF_DOUBLE, 1, nc_srcgrdsize_id,  &
+                           nc_srcgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdfrac_id,  &
+                                'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'frac_b',  &
+                           NF_DOUBLE, 1, nc_dstgrdsize_id,  &
+                           nc_dstgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdfrac_id,  &
+                                'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define mapping arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'col',  &
+                           NF_INT, 1, nc_numlinks_id,  &
+                           nc_srcadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'row',  &
+                           NF_INT, 1, nc_numlinks_id,  &
+                           nc_dstadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'S',  &
+                           NF_DOUBLE, 1, nc_numlinks_id,  &
+                           nc_rmpmatrix_id)
+      call netcdf_error_handler(ncstat)
+
+      if (num_wts > 1) then
+        nc_dims2_id(1) = nc_numwgts1_id
+        nc_dims2_id(2) = nc_numlinks_id
+
+        ncstat = nf_def_var (nc_file_id, 'S2',  &
+                           NF_DOUBLE, 2, nc_dims2_id,  &
+                           nc_rmpmatrix2_id)
+        call netcdf_error_handler(ncstat)
+      endif
+
+      !***
+      !*** end definition stage
+      !***
+
+      ncstat = nf_enddef(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     compute integer masks
+!
+!-----------------------------------------------------------------------
+
+      if (direction == 1) then
+        allocate (src_mask_int(grid1_size), &
+                  dst_mask_int(grid2_size))
+
+        where (grid2_mask)
+          dst_mask_int = 1
+        elsewhere
+          dst_mask_int = 0
+        endwhere
+
+        where (grid1_mask)
+          src_mask_int = 1
+        elsewhere
+          src_mask_int = 0
+        endwhere
+      else
+        allocate (src_mask_int(grid2_size), &
+                  dst_mask_int(grid1_size))
+
+        where (grid1_mask)
+          dst_mask_int = 1
+        elsewhere
+          dst_mask_int = 0
+        endwhere
+
+        where (grid2_mask)
+          src_mask_int = 1
+        elsewhere
+          src_mask_int = 0
+        endwhere
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     change units of lat/lon coordinates if input units different
+!     from radians. if this is the second mapping, the conversion has
+!     alread been done.
+!
+!-----------------------------------------------------------------------
+
+      if (grid1_units(1:7) == 'degrees' .and. direction == 1) then
+        grid1_center_lat = grid1_center_lat/deg2rad
+        grid1_center_lon = grid1_center_lon/deg2rad
+        grid1_corner_lat = grid1_corner_lat/deg2rad
+        grid1_corner_lon = grid1_corner_lon/deg2rad
+      endif
+
+      if (grid2_units(1:7) == 'degrees' .and. direction == 1) then
+        grid2_center_lat = grid2_center_lat/deg2rad
+        grid2_center_lon = grid2_center_lon/deg2rad
+        grid2_corner_lat = grid2_corner_lat/deg2rad
+        grid2_corner_lon = grid2_corner_lon/deg2rad
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     write mapping data
+!
+!-----------------------------------------------------------------------
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrddims_id
+        itmp2 = nc_dstgrddims_id
+      else
+        itmp2 = nc_srcgrddims_id
+        itmp1 = nc_dstgrddims_id
+      endif
+
+      ncstat = nf_put_var_int(nc_file_id, itmp1, grid1_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, itmp2, grid2_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, nc_srcgrdimask_id,  &
+                              src_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, nc_dstgrdimask_id, &
+                              dst_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      deallocate(src_mask_int, dst_mask_int)
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrdcntrlat_id
+        itmp2 = nc_srcgrdcntrlon_id
+        itmp3 = nc_srcgrdcrnrlat_id
+        itmp4 = nc_srcgrdcrnrlon_id
+      else
+        itmp1 = nc_dstgrdcntrlat_id
+        itmp2 = nc_dstgrdcntrlon_id
+        itmp3 = nc_dstgrdcrnrlat_id
+        itmp4 = nc_dstgrdcrnrlon_id
+      endif
+
+      ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp3, grid1_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid1_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        itmp1 = nc_dstgrdcntrlat_id
+        itmp2 = nc_dstgrdcntrlon_id
+        itmp3 = nc_dstgrdcrnrlat_id
+        itmp4 = nc_dstgrdcrnrlon_id
+      else
+        itmp1 = nc_srcgrdcntrlat_id
+        itmp2 = nc_srcgrdcntrlon_id
+        itmp3 = nc_srcgrdcrnrlat_id
+        itmp4 = nc_srcgrdcrnrlon_id
+      endif
+
+      ncstat = nf_put_var_double(nc_file_id, itmp1, grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid2_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrdarea_id
+        itmp2 = nc_srcgrdfrac_id
+        itmp3 = nc_dstgrdarea_id
+        itmp4 = nc_dstgrdfrac_id
+      else
+        itmp1 = nc_dstgrdarea_id
+        itmp2 = nc_dstgrdfrac_id
+        itmp3 = nc_srcgrdarea_id
+        itmp4 = nc_srcgrdfrac_id
+      endif
+
+      if (luse_grid1_area) then
+        ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_area_in)
+      else
+        ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_area)
+      endif
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid1_frac)
+      call netcdf_error_handler(ncstat)
+
+      if (luse_grid2_area) then
+        ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_area)
+      else
+        ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_area)
+      endif
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid2_frac)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        ncstat = nf_put_var_int(nc_file_id, nc_srcadd_id,  &
+                                grid1_add_map1)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_int(nc_file_id, nc_dstadd_id,  &
+                                grid2_add_map1)
+        call netcdf_error_handler(ncstat)
+
+        if (num_wts == 1) then
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id,  &
+                                     wts_map1)
+          call netcdf_error_handler(ncstat)
+        else
+          allocate(wts1(num_links_map1),wts2(num_wts-1,num_links_map1))
+
+          wts1 = wts_map1(1,:)
+          wts2 = wts_map1(2:,:)
+
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id,  &
+                                     wts1)
+          call netcdf_error_handler(ncstat)
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix2_id,  &
+                                     wts2)
+          call netcdf_error_handler(ncstat)
+          deallocate(wts1,wts2)
+        endif
+      else
+        ncstat = nf_put_var_int(nc_file_id, nc_srcadd_id,  &
+                                grid2_add_map2)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_int(nc_file_id, nc_dstadd_id,  &
+                                grid1_add_map2)
+        call netcdf_error_handler(ncstat)
+
+        if (num_wts == 1) then
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id,  &
+                                     wts_map2)
+          call netcdf_error_handler(ncstat)
+        else
+          allocate(wts1(num_links_map2),wts2(num_wts-1,num_links_map2))
+
+          wts1 = wts_map2(1,:)
+          wts2 = wts_map2(2:,:)
+
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id,  &
+                                     wts1)
+          call netcdf_error_handler(ncstat)
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix2_id,  &
+                                     wts2)
+          call netcdf_error_handler(ncstat)
+          deallocate(wts1,wts2)
+        endif
+      endif
+
+      ncstat = nf_close(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end subroutine write_remap_csm
+
+!***********************************************************************
+
+      subroutine sort_add(add1, add2, weights)
+
+!-----------------------------------------------------------------------
+!
+!     this routine sorts address and weight arrays based on the
+!     destination address with the source address as a secondary
+!     sorting criterion.  the method is a standard heap sort.
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common scalar constants
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     Input and Output arrays
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(inout), dimension(:) :: &
+              add1,        & ! destination address array (num_links)
+              add2        ! source      address array
+
+      real (kind=dbl_kind), intent(inout), dimension(:,:) :: &
+              weights     ! remapping weights (num_wts, num_links)
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: &
+                num_links,           & ! num of links for this mapping
+                num_wts,             & ! num of weights for this mapping
+                add1_tmp, add2_tmp,  & ! temp for addresses during swap
+                nwgt, &
+                lvl, final_lvl,      & ! level indexes for heap sort levels
+                chk_lvl1, chk_lvl2, max_lvl
+
+      real (kind=dbl_kind), dimension(SIZE(weights,DIM=1)) :: &
+                wgttmp              ! temp for holding wts during swap
+
+!-----------------------------------------------------------------------
+!
+!     determine total number of links to sort and number of weights
+!
+!-----------------------------------------------------------------------
+
+      num_links = SIZE(add1)
+      num_wts   = SIZE(weights, DIM=1)
+
+!-----------------------------------------------------------------------
+!
+!     start at the lowest level (N/2) of the tree and sift lower 
+!     values to the bottom of the tree, promoting the larger numbers
+!
+!-----------------------------------------------------------------------
+
+      do lvl=num_links/2,1,-1
+
+        final_lvl = lvl
+        add1_tmp = add1(lvl)
+        add2_tmp = add2(lvl)
+        wgttmp(:) = weights(:,lvl)
+
+        !***
+        !*** loop until proper level is found for this link, or reach
+        !*** bottom
+        !***
+
+        sift_loop1: do
+
+          !***
+          !*** find the largest of the two daughters
+          !***
+
+          chk_lvl1 = 2*final_lvl
+          chk_lvl2 = 2*final_lvl+1
+          if (chk_lvl1 .EQ. num_links) chk_lvl2 = chk_lvl1
+
+          if ((add1(chk_lvl1) >  add1(chk_lvl2)) .OR. &
+             ((add1(chk_lvl1) == add1(chk_lvl2)) .AND. &
+              (add2(chk_lvl1) >  add2(chk_lvl2)))) then
+            max_lvl = chk_lvl1
+          else 
+            max_lvl = chk_lvl2
+          endif
+
+          !***
+          !*** if the parent is greater than both daughters,
+          !*** the correct level has been found
+          !***
+
+          if ((add1_tmp .GT. add1(max_lvl)) .OR. &
+             ((add1_tmp .EQ. add1(max_lvl)) .AND. &
+              (add2_tmp .GT. add2(max_lvl)))) then
+            add1(final_lvl) = add1_tmp
+            add2(final_lvl) = add2_tmp
+            weights(:,final_lvl) = wgttmp(:)
+            exit sift_loop1
+
+          !***
+          !*** otherwise, promote the largest daughter and push
+          !*** down one level in the tree.  if haven't reached
+          !*** the end of the tree, repeat the process.  otherwise
+          !*** store last values and exit the loop
+          !***
+
+          else 
+            add1(final_lvl) = add1(max_lvl)
+            add2(final_lvl) = add2(max_lvl)
+            weights(:,final_lvl) = weights(:,max_lvl)
+
+            final_lvl = max_lvl
+            if (2*final_lvl > num_links) then
+              add1(final_lvl) = add1_tmp
+              add2(final_lvl) = add2_tmp
+              weights(:,final_lvl) = wgttmp(:)
+              exit sift_loop1
+            endif
+          endif
+        end do sift_loop1
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     now that the heap has been sorted, strip off the top (largest)
+!     value and promote the values below
+!
+!-----------------------------------------------------------------------
+
+      do lvl=num_links,3,-1
+
+        !***
+        !*** move the top value and insert it into the correct place
+        !***
+
+        add1_tmp = add1(lvl)
+        add1(lvl) = add1(1)
+
+        add2_tmp = add2(lvl)
+        add2(lvl) = add2(1)
+
+        wgttmp(:) = weights(:,lvl)
+        weights(:,lvl) = weights(:,1)
+
+        !***
+        !*** as above this loop sifts the tmp values down until proper 
+        !*** level is reached
+        !***
+
+        final_lvl = 1
+
+        sift_loop2: do
+
+          !***
+          !*** find the largest of the two daughters
+          !***
+
+          chk_lvl1 = 2*final_lvl
+          chk_lvl2 = 2*final_lvl+1
+          if (chk_lvl2 >= lvl) chk_lvl2 = chk_lvl1
+
+          if ((add1(chk_lvl1) >  add1(chk_lvl2)) .OR. &
+             ((add1(chk_lvl1) == add1(chk_lvl2)) .AND. &
+              (add2(chk_lvl1) >  add2(chk_lvl2)))) then
+            max_lvl = chk_lvl1
+          else 
+            max_lvl = chk_lvl2
+          endif
+
+          !***
+          !*** if the parent is greater than both daughters,
+          !*** the correct level has been found
+          !***
+
+          if ((add1_tmp >  add1(max_lvl)) .OR. &
+             ((add1_tmp == add1(max_lvl)) .AND. &
+              (add2_tmp >  add2(max_lvl)))) then
+            add1(final_lvl) = add1_tmp
+            add2(final_lvl) = add2_tmp
+            weights(:,final_lvl) = wgttmp(:)
+            exit sift_loop2
+
+          !***
+          !*** otherwise, promote the largest daughter and push
+          !*** down one level in the tree.  if haven't reached
+          !*** the end of the tree, repeat the process.  otherwise
+          !*** store last values and exit the loop
+          !***
+
+          else 
+            add1(final_lvl) = add1(max_lvl)
+            add2(final_lvl) = add2(max_lvl)
+            weights(:,final_lvl) = weights(:,max_lvl)
+
+            final_lvl = max_lvl
+            if (2*final_lvl >= lvl) then
+              add1(final_lvl) = add1_tmp
+              add2(final_lvl) = add2_tmp
+              weights(:,final_lvl) = wgttmp(:)
+              exit sift_loop2
+            endif
+          endif
+        end do sift_loop2
+      end do
+
+      !***
+      !*** swap the last two entries
+      !***
+
+
+      add1_tmp = add1(2)
+      add1(2)  = add1(1)
+      add1(1)  = add1_tmp
+
+      add2_tmp = add2(2)
+      add2(2)  = add2(1)
+      add2(1)  = add2_tmp
+
+      wgttmp (:)   = weights(:,2)
+      weights(:,2) = weights(:,1)
+      weights(:,1) = wgttmp (:)
+
+!-----------------------------------------------------------------------
+
+      end subroutine sort_add
+
+!***********************************************************************
+
+      end module remap_write
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/scrip.F90
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/scrip.F90	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/scrip.F90	(revision 2352)
@@ -0,0 +1,232 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This routine is the driver for computing the addresses and weights 
+!     for interpolating between two grids on a sphere.
+!
+!     Modified slightly to get name of namelist file from command line - sga 2/12/05
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: scrip.f,v 1.6 2001/08/21 21:06:44 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      program scrip
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod                  ! module defining data types
+      use constants                  ! module for common constants
+      use iounits                    ! I/O unit manager
+      use timers                     ! CPU timers
+      use grids                      ! module with grid information
+      use remap_vars                 ! common remapping variables
+      use remap_conservative         ! routines for conservative remap
+      use remap_distance_weight      ! routines for dist-weight remap
+      use remap_bilinear             ! routines for bilinear interp
+      use remap_bicubic              ! routines for bicubic  interp
+      use remap_write                ! routines for remap output
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     input namelist variables
+!
+!-----------------------------------------------------------------------
+
+      character (char_len) :: &
+         grid1_file,       &  ! filename of grid file containing grid1
+         grid2_file,       &  ! filename of grid file containing grid2
+         interp_file1,     &  ! filename for output remap data (map1)
+         interp_file2,     &  ! filename for output remap data (map2)
+         map1_name,        &  ! name for mapping from grid1 to grid2
+         map2_name,        &  ! name for mapping from grid2 to grid1
+         map_method,       &  ! choice for mapping method
+         normalize_opt,    &  ! option for normalizing weights
+         output_opt           ! option for output conventions
+
+      integer (kind=int_kind) :: &
+         nmap                 ! number of mappings to compute (1 or 2)
+
+      namelist /remap_inputs/ grid1_file, grid2_file,  &
+         interp_file1, interp_file2,                   &
+         map1_name, map2_name, num_maps,               &
+         luse_grid1_area, luse_grid2_area,             &
+         map_method, normalize_opt, output_opt,        &
+         restrict_type, num_srch_bins
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n,   &  ! dummy counter
+                                 iunit   ! unit number for namelist file
+
+      character (char_len) :: nm_in
+#if defined ARGC
+      integer :: iargc
+      external iargc
+
+      if (iargc() == 1) then
+        call getarg(1, nm_in)
+      else
+        write(6,*) 'need name of namelist file'
+        stop
+      endif
+#else
+      write(6,*) 'enter name for namelist file'
+      read(5,*) nm_in
+#endif
+
+!-----------------------------------------------------------------------
+!
+!     initialize timers
+!
+!-----------------------------------------------------------------------
+
+      call timers_init
+      do n=1,max_timers
+        call timer_clear(n)
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     read input namelist
+!
+!-----------------------------------------------------------------------
+
+      grid1_file    = 'unknown'
+      grid2_file    = 'unknown'
+      interp_file1  = 'unknown'
+      interp_file2  = 'unknown'
+      map1_name     = 'unknown'
+      map2_name     = 'unknown'
+      luse_grid1_area = .false.
+      luse_grid2_area = .false.
+      num_maps      = 2
+      map_type      = 1
+      normalize_opt = 'fracarea'
+      output_opt    = 'scrip'
+      restrict_type = 'latitude'
+      num_srch_bins = 900
+
+      call get_unit(iunit)
+      open(iunit, file=nm_in, status='old', form='formatted')
+      read(iunit, nml=remap_inputs)
+      call release_unit(iunit)
+
+      select case(map_method)
+      case ('conservative')
+        map_type = map_type_conserv
+        luse_grid_centers = .false.
+      case ('bilinear')
+        map_type = map_type_bilinear
+        luse_grid_centers = .true.
+      case ('bicubic')
+        map_type = map_type_bicubic
+        luse_grid_centers = .true.
+      case ('distwgt')
+        map_type = map_type_distwgt
+        luse_grid_centers = .true.
+      case default
+        stop 'unknown mapping method'
+      end select
+
+      select case(normalize_opt(1:4))
+      case ('none')
+        norm_opt = norm_opt_none
+      case ('frac')
+        norm_opt = norm_opt_frcarea
+      case ('dest')
+        norm_opt = norm_opt_dstarea
+      case default
+        stop 'unknown normalization option'
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     initialize grid information for both grids
+!
+!-----------------------------------------------------------------------
+
+      call grid_init(grid1_file, grid2_file)
+
+      write(stdout, *) ' Computing remappings between: ',grid1_name
+      write(stdout, *) '                          and  ',grid2_name
+
+!-----------------------------------------------------------------------
+!
+!     initialize some remapping variables.
+!
+!-----------------------------------------------------------------------
+
+      call init_remap_vars
+
+!-----------------------------------------------------------------------
+!
+!     call appropriate interpolation setup routine based on type of
+!     remapping requested.
+!
+!-----------------------------------------------------------------------
+
+      select case(map_type)
+      case(map_type_conserv)
+        call remap_conserv
+      case(map_type_bilinear)
+        call remap_bilin
+      case(map_type_distwgt)
+        call remap_distwgt
+      case(map_type_bicubic)
+        call remap_bicub
+      case default
+        stop 'Invalid Map Type'
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     reduce size of remapping arrays and then write remapping info
+!     to a file.
+!
+!-----------------------------------------------------------------------
+
+      if (num_links_map1 /= max_links_map1) then
+        call resize_remap_vars(1, num_links_map1-max_links_map1)
+      endif
+      if ((num_maps > 1) .and. (num_links_map2 /= max_links_map2)) then
+        call resize_remap_vars(2, num_links_map2-max_links_map2)
+      endif
+
+      call write_remap(map1_name, map2_name, &
+                       interp_file1, interp_file2, output_opt)
+
+!-----------------------------------------------------------------------
+
+      end program scrip
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/scripgrid.F90
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/scripgrid.F90	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/scripgrid.F90	(revision 2352)
@@ -0,0 +1,26 @@
+! ==============================================================================
+
+PROGRAM scripgrid
+
+  USE scripgrid_mod
+
+  CHARACTER(char_len) :: infile
+
+#if defined ARGC
+  INTEGER :: IARGC
+  EXTERNAL IARGC
+
+  if (IARGC() == 1) then
+    CALL GETARG(1, infile)
+    CALL convert( infile )
+  ELSE
+    write(6,*) 'need to supply a namelist file'
+  ENDIF
+#else
+  write(6,*) 'enter name of namelist file'
+  read(5,*) infile
+
+  CALL convert( infile )
+#endif
+
+END PROGRAM scripgrid
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/scripgrid_mod.F90
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/scripgrid_mod.F90	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/scripgrid_mod.F90	(revision 2352)
@@ -0,0 +1,764 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module creates grid description files for input to the SCRIP code
+!
+!-----------------------------------------------------------------------
+
+MODULE scripgrid_mod
+
+  USE kinds_mod
+  USE constants
+  USE iounits
+  USE netcdf
+  USE netcdf_mod
+  
+  IMPLICIT NONE
+
+  !-----------------------------------------------------------------------
+  !     module variables that describe the grid
+
+  INTEGER (kind=int_kind), parameter :: &
+       grid_rank = 2,         &
+       grid_corners = 4
+  INTEGER (kind=int_kind) :: nx, ny, grid_size
+  INTEGER (kind=int_kind), dimension(2) :: &
+       grid_dims,    &  ! size of x, y dimensions
+       grid_dim_ids     ! ids of the x, y dimensions
+  INTEGER (kind=int_kind), ALLOCATABLE, DIMENSION(:) :: &
+       grid_imask          ! land-sea mask
+  REAL (kind=int_kind), ALLOCATABLE, DIMENSION(:) :: &
+       grid_center_lat, &  ! lat/lon coordinates for
+       grid_center_lon     ! each grid center in degrees
+  REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:,:) :: &
+       grid_corner_lat, &  ! lat/lon coordinates for
+       grid_corner_lon     ! each grid corner in degrees
+  REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:,:,:) :: &
+       corner_lon, &
+       corner_lat
+  REAL (kind=dbl_kind), PARAMETER :: circle = 360.0
+
+  !-----------------------------------------------------------------------
+  !     module variables that describe the netcdf file
+
+  INTEGER (kind=int_kind) :: &
+       ncstat,           &   ! general netCDF status variable
+       ncid_in
+
+CONTAINS
+
+  ! ==============================================================================
+  
+  SUBROUTINE convert(nm_in)
+  
+    ! -----------------------------------------------------------------------------
+    ! - input variables
+  
+    CHARACTER(char_len), INTENT(in) ::  &
+      nm_in
+  
+    ! -----------------------------------------------------------------------------
+    ! - local variables
+  
+    CHARACTER(char_len) ::  &
+      nemo_file, input_file, method, input_lon, input_lat, datagrid_file, &
+      nemogrid_file, nemo_lon, nemo_lat, corn_lon, corn_lat, nemo_mask, input_mask
+    INTEGER (kind=int_kind), dimension(2) :: &
+      offset
+    INTEGER (kind=int_kind) :: &
+      iunit, nemo_mask_value, input_mask_value
+  
+    namelist /grid_inputs/ nemo_file, input_file, datagrid_file, nemogrid_file,  &
+                           method, input_lon, input_lat, nemo_lon, nemo_lat,     &
+                           nemo_mask, nemo_mask_value, input_mask, input_mask_value
+  
+    !-----------------------------------------------------------------------
+    ! - namelist describing the processing
+    !   note that mask_value is the minimum good value,
+    !   so that where the mask is less than the value is masked
+
+    nemo_file = "coordinates.nc"
+    nemo_lon = "glamt"
+    nemo_lat = "gphit"
+    input_lon = "lon"
+    input_lat = "lat"
+    input_mask = "none"
+    input_mask_value = 0
+    datagrid_file = 'remap_data_grid.nc'
+    nemogrid_file = 'remap_nemo_grid.nc'
+
+    call get_unit(iunit)
+    open(iunit, file=nm_in, status='old', form='formatted')
+    read(iunit, nml=grid_inputs) 
+    call release_unit(iunit)
+
+    if (trim(nemo_file) .eq. 'coordinates.nc') then
+
+      ! set up the names of the corner variables for a given input
+      ! the offset represents what needs to be added to (i,j) to get to the correct 
+      ! element in the corner arrays to correspond to the point northeast of the center
+      if (nemo_lon(5:5) == "t") then
+        corn_lon = "glamf"
+        corn_lat = "gphif"
+        offset = (/ 0,0 /)
+      else if (nemo_lon(5:5) == "u") then
+        corn_lon = "glamv"
+        corn_lat = "gphiv"
+        offset = (/ 1,0 /)
+      else if (nemo_lon(5:5) == "v") then
+        corn_lon = "glamu"
+        corn_lat = "gphiu"
+        offset = (/ 0,1 /)
+      else
+        write(6,*) 'unknown nemo_lon name'
+        stop
+      endif
+
+      write(6,*) "processing " // trim(nemo_file)
+      call convertNEMO(nemo_file, nemo_lon, nemo_lat, corn_lon, corn_lat, &
+                       offset, nemogrid_file)
+
+    else
+
+      write(6,*) "processing regular grid " // trim(nemo_file)
+      call convertFLUX(nemo_file, nemo_lon, nemo_lat, &
+                       nemo_mask, nemo_mask_value, nemogrid_file)
+
+    endif
+
+    write(6,*) "processing regular grid"
+    call convertFLUX(input_file, input_lon, input_lat, &
+                     input_mask, input_mask_value, datagrid_file)
+
+  END SUBROUTINE convert
+  
+  ! ==============================================================================
+  
+  SUBROUTINE convertNEMO(grid_file_in, cent_lon, cent_lat, corn_lon, corn_lat, &
+                         off, grid_file_out)
+  
+    !-----------------------------------------------------------------------
+    !
+    !     This routine converts a NEMO coordinates.nc file to a remapping grid file.
+    !
+    
+    CHARACTER(char_len), INTENT(in) :: cent_lon, cent_lat, corn_lon, corn_lat
+    INTEGER (kind=int_kind), INTENT(in), DIMENSION(2) :: off
+    CHARACTER(char_len), INTENT(in) :: grid_file_out
+    CHARACTER(char_len), INTENT(in) :: grid_file_in
+
+    !-----------------------------------------------------------------------
+    !     module variables that describe the grid
+  
+    CHARACTER(char_len), parameter ::  &
+         grid_name = 'Remapped NEMO grid for SCRIP'
+  
+    !-----------------------------------------------------------------------
+    !     grid coordinates and masks
+  
+    REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:,:) :: &
+         clon, clat, &             ! expanded corner arrays
+         glam, &                   ! center longitude
+         gphi, &                   ! center latitude
+         glamc, &                  ! corner longitude
+         gphic                     ! corner latitude
+  
+    !-----------------------------------------------------------------------
+    !     other local variables
+  
+    INTEGER (kind=int_kind) :: i, j, n, iunit, im1, jm1, imid, isame, ic, jc
+    INTEGER (kind=int_kind) :: varid_lam, varid_phi, varid_lamc, varid_phic
+    INTEGER (kind=int_kind) :: jdim
+    INTEGER (kind=int_kind), dimension(4) :: grid_dimids  ! input fields have 4 dims
+    REAL (kind=dbl_kind) :: tmplon, dxt, dyt
+  
+    !-----------------------------------------------------------------------
+    !     read in grid info
+    !
+    !     For NEMO input grids, assume that variable names are glam, glamc etc.
+    !     Assume that 1st 2 dimensions of these variables are x and y directions.
+    !     These assumptions are made by NEMO, so should be valid for coordinates.nc.
+    !
+    ! write in nf90 calls (without error handling) and then think about 
+    ! making more readable by taking chunks into ncutil
+    !
+  
+    ncstat = nf90_open( grid_file_in, NF90_NOWRITE, ncid_in )
+    call netcdf_error_handler(ncstat)
+  
+    ! find dimids for 'glam'
+    ! use dimids to get dimlengths
+    ! allocate glam array
+    ! get glam from file 
+  
+    ncstat = nf90_inq_varid( ncid_in, cent_lon, varid_lam )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_inq_varid( ncid_in, corn_lon, varid_lamc )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_inq_varid( ncid_in, cent_lat, varid_phi )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_inq_varid( ncid_in, corn_lat, varid_phic )
+    call netcdf_error_handler(ncstat)
+  
+    ncstat = nf90_inquire_variable( ncid_in, varid_lam, dimids=grid_dimids(:) )
+    call netcdf_error_handler(ncstat)
+    DO jdim = 1, SIZE(grid_dims)
+       ncstat = nf90_inquire_dimension( ncid_in, grid_dimids(jdim),  &
+                                        len=grid_dims(jdim) )
+       call netcdf_error_handler(ncstat)
+    END DO
+    nx = grid_dims(1)
+    ny = grid_dims(2)
+    grid_size = nx * ny
+    WRITE(*,FMT='("Input grid dimensions are:",2i6)') nx, ny
+    
+    ! assume that dimensions are all the same as glam
+    ALLOCATE( glam(nx,ny), glamc(nx,ny), gphi(nx,ny), gphic(nx,ny) )
+    ncstat = nf90_get_var( ncid_in, varid_lam, glam(:,:) )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_get_var( ncid_in, varid_lamc, glamc(:,:) )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_get_var( ncid_in, varid_phi, gphi(:,:) )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_get_var( ncid_in, varid_phic, gphic(:,:) )
+    call netcdf_error_handler(ncstat)
+    
+    !-----------------------------------------------------------------------
+    ! - Mask is all ocean for now
+  
+    ALLOCATE( grid_imask(grid_size) )
+    grid_imask(:) = 1
+  
+    !-----------------------------------------------------------------------
+    ! corners are arranged as follows:    4 3
+    !                                     1 2
+    !
+    ! Assume that cyclic grids have 2 wrap columns in coordinates.nc
+    !  (this is the case for ORCA grids)
+    !
+  
+    ! -----------------------------------------------------------------------------
+    ! create a single pair of arrays for the corners where clon(1,1) corresponds
+    ! to the south west corner of a box containing glam(1,1)
+    ! various special cases then apply
+    !   bottom row:  assume clon(:,j) = clon(:,j+1)
+  
+    ALLOCATE ( clon(nx+1,ny+1), clat(nx+1,ny+1) )
+
+    ! first the easy internal points
+    DO j = 2,ny
+      DO i = 2,nx
+        ic = i + off(1) - 1
+        jc = j + off(2) - 1
+        clon(i,j) = glamc(ic,jc)
+        clat(i,j) = gphic(ic,jc)
+      ENDDO
+    ENDDO
+
+    ! then the tricky boundary points
+    imid = (nx-1)/2 + 1
+    DO j = 1,ny+1,ny
+      DO i = 1,nx+1,nx
+        ic = i + off(1) - 1
+        jc = j + off(2) - 1
+        if (ic == 0 .and. jc == 0) then
+          clon(i,j) = glamc(nx,1)
+          clat(i,j) = gphic(nx,1) - (gphic(nx,2)-gphic(nx,1))
+        else if (ic == nx+1 .and. jc == 0) then
+          clon(i,j) = glamc(1,1)
+          clat(i,j) = gphic(1,1) - (gphic(1,2)-gphic(1,1))
+        else if (ic == 0 .and. jc == ny+1) then
+          isame = 2*imid - nx + 1
+          clon(i,j) = glamc(isame,jc-1)
+          clat(i,j) = gphic(isame,jc-1)
+        else if (ic == nx+1 .and. jc == ny+1) then
+          isame = 2*imid
+          clon(i,j) = glamc(isame,jc-1)
+          clat(i,j) = gphic(isame,jc-1)
+        else if (ic == 0) then
+          clon(i,j) = glamc(nx,jc)
+          clat(i,j) = gphic(nx,jc)
+        else if (jc == 0) then
+          clon(i,j) = glamc(ic,1)
+          clat(i,j) = gphic(ic,1) - (gphic(ic,2)-gphic(ic,1))
+        else if (ic == nx+1) then
+          clon(i,j) = glamc(1,jc)
+          clat(i,j) = gphic(1,jc)
+        else if (jc == ny+1) then
+          isame = 2*imid - ic + 1
+          clon(i,j) = glamc(isame,jc-1)
+          clat(i,j) = gphic(isame,jc-1)
+        endif
+      ENDDO
+    ENDDO
+
+    ALLOCATE ( corner_lon(4,nx,ny), corner_lat(4,nx,ny) )
+  
+    ! top-right corner
+    corner_lon(3,:,:) = clon(2:nx+1,2:ny+1)
+    corner_lat(3,:,:) = clat(2:nx+1,2:ny+1)
+  
+    ! top-left corner
+    corner_lon(4,:,:) = clon(1:nx,2:ny+1)
+    corner_lat(4,:,:) = clat(1:nx,2:ny+1)
+  
+    ! bottom-right corner 
+    corner_lon(2,:,:) = clon(2:nx+1,1:ny)
+    corner_lat(2,:,:) = clat(2:nx+1,1:ny)
+  
+    ! bottom-left corner
+    corner_lon(1,:,:) = clon(1:nx,1:ny)
+    corner_lat(1,:,:) = clat(1:nx,1:ny)
+  
+  ! For [N, E, W]-ward extrapolation near the poles, should we use stereographic (or
+  ! similar) projection?  This issue will come for V,F interpolation, and for all
+  ! grids with non-cyclic grids.
+  
+    ! -----------------------------------------------------------------------------
+    !     correct for 0,2pi longitude crossings
+    !      (In practice this means putting all corners into 0,2pi range
+    !       and ensuring that no box corners are miles from each other.
+    !       3pi/2 is used as threshold - I think this is quite arbitrary.)
+  
+    corner_lon(:,:,:) = MODULO( corner_lon(:,:,:), circle )
+    DO n = 2, grid_corners
+       WHERE    ( corner_lon(n,:,:) - corner_lon(n-1,:,:) < -three*circle*0.25 )
+          corner_lon(n,:,:) = corner_lon(n,:,:) + circle
+       ELSEWHERE( corner_lon(n,:,:) - corner_lon(n-1,:,:) >  three*circle*0.25 )
+          corner_lon(n,:,:) = corner_lon(n,:,:) - circle
+       END WHERE
+    END DO
+  
+    ! -----------------------------------------------------------------------------
+    ! - put longitudes on smooth grid 
+  
+ !  call mouldlon(glam,nx,ny)
+ !  call mouldlon(corner_lon(1,:,:),nx,ny)
+ !  call mouldlon(corner_lon(2,:,:),nx,ny)
+ !  call mouldlon(corner_lon(3,:,:),nx,ny)
+ !  call mouldlon(corner_lon(4,:,:),nx,ny)
+
+    ! -----------------------------------------------------------------------------
+    ! - reshape for SCRIP input format
+  
+    ALLOCATE( grid_center_lon(grid_size), grid_center_lat(grid_size) )
+    
+    grid_center_lon(:) = RESHAPE( glam(:,:), (/ grid_size /) )
+    grid_center_lat(:) = RESHAPE( gphi(:,:), (/ grid_size /) )
+  
+    DEALLOCATE( glam, gphi, glamc, gphic )
+  
+    ALLOCATE( grid_corner_lon(4, grid_size), grid_corner_lat(4, grid_size) )
+  
+    grid_corner_lon(:,:) = RESHAPE( corner_lon(:,:,:), (/ 4, grid_size /) )
+    grid_corner_lat(:,:) = RESHAPE( corner_lat(:,:,:), (/ 4, grid_size /) )
+  
+    DEALLOCATE( corner_lon, corner_lat )
+  
+    CALL createSCRIPgrid(grid_file_out, grid_name)
+  
+  END SUBROUTINE convertNEMO
+  
+  ! ==============================================================================
+  
+  SUBROUTINE convertFLUX(grid_file_in, name_lon, name_lat, &
+                         name_mask, value_mask, grid_file_out)
+  
+    !-----------------------------------------------------------------------
+    !
+    !     This routine creates a remapping grid file from an input grid.
+    !
+    !-----------------------------------------------------------------------
+    
+    CHARACTER(char_len), INTENT(in) ::  &
+         grid_file_in, name_lon, name_lat, name_mask, grid_file_out
+    INTEGER (kind=int_kind) :: value_mask
+  
+    !-----------------------------------------------------------------------
+    !     variables that describe the grid
+  
+    CHARACTER(char_len), parameter ::  &
+         grid_name = 'Remapped regular grid for SCRIP'
+  
+    !-----------------------------------------------------------------------
+    !     grid coordinates (note that a flux file just has lon and lat)
+  
+    REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:) :: &
+         lam, phi
+    REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:,:) :: &
+         glam, &                   ! longitude
+         gphi, &                   ! latitude
+         glamc, &
+         gphic
+    REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:,:) :: mask
+  
+    !-----------------------------------------------------------------------
+    !     other local variables
+  
+    INTEGER (kind=int_kind) :: i, j, n, iunit, im1, jm1
+    INTEGER (kind=int_kind) :: varid_lam, varid_phi, varid_mask
+    INTEGER (kind=int_kind) :: jdim, nspace
+    INTEGER (kind=int_kind), dimension(4) :: grid_dimids  ! input fields have 4 dims
+    REAL (kind=dbl_kind) :: tmplon, dxt, dyt
+  
+    !-----------------------------------------------------------------------
+    !     read in grid info
+    !
+    !     For NEMO input grids, assume that variable names are glam, glamc etc.
+    !     Assume that 1st 2 dimensions of these variables are x and y directions.
+    !     These assumptions are made by NEMO, so should be valid for coordinates.nc.
+    !
+    ! write in nf90 calls (without error handling) and then think about 
+    ! making more readable by taking chunks into ncutil
+  
+    ncstat = nf90_open( grid_file_in, NF90_NOWRITE, ncid_in )
+    call netcdf_error_handler(ncstat)
+  
+    ! find dimids for 'glamt'
+    ! use dimids to get dimlengths
+    ! allocate glam array
+    ! get glam from file 
+  
+    ncstat = nf90_inq_varid( ncid_in, name_lat, varid_phi )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_inq_varid( ncid_in, name_lon, varid_lam )
+    call netcdf_error_handler(ncstat)
+  
+    ncstat = nf90_inquire_variable( ncid_in, varid_lam, ndims=nspace )
+    call netcdf_error_handler(ncstat)
+
+    if (nspace == 1) then
+      ncstat = nf90_inquire_variable( ncid_in, varid_lam, dimids=grid_dimids(:1) )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_inquire_variable( ncid_in, varid_phi, dimids=grid_dimids(2:) )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_inquire_dimension( ncid_in, grid_dimids(1), len=grid_dims(1) )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_inquire_dimension( ncid_in, grid_dimids(2), len=grid_dims(2) )
+      call netcdf_error_handler(ncstat)
+      nx = grid_dims(1)
+      ny = grid_dims(2)
+      grid_size = nx * ny
+      WRITE(*,FMT='("Input grid dimensions are:",2i6)') nx, ny
+    
+      ALLOCATE( lam(nx), phi(ny) )
+      write(6,*) 'double'
+      ncstat = nf90_get_var( ncid_in, varid_lam, lam )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_get_var( ncid_in, varid_phi, phi )
+      call netcdf_error_handler(ncstat)
+    
+      ALLOCATE( glam(nx,ny), gphi(nx,ny))
+      write(6,*) shape(lam),shape(phi)
+      glam(:,:) = SPREAD(lam,2,ny)
+      gphi(:,:) = SPREAD(phi,1,nx)
+    else
+
+      ncstat = nf90_inquire_variable( ncid_in, varid_lam, dimids=grid_dimids(:2) )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_inquire_dimension( ncid_in, grid_dimids(1), len=grid_dims(1) )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_inquire_dimension( ncid_in, grid_dimids(2), len=grid_dims(2) )
+      call netcdf_error_handler(ncstat)
+      nx = grid_dims(1)
+      ny = grid_dims(2)
+      grid_size = nx * ny
+      WRITE(*,FMT='("Input grid dimensions are:",2i6)') nx, ny
+    
+      ALLOCATE( glam(nx,ny), gphi(nx,ny))
+      ncstat = nf90_get_var( ncid_in, varid_lam, glam )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_get_var( ncid_in, varid_phi, gphi )
+      call netcdf_error_handler(ncstat)
+
+    endif
+    write(6,*) grid_size,nx,ny
+  
+    ALLOCATE(glamc(0:nx,0:ny), gphic(0:nx,0:ny) )
+
+    ! - for now a simple average to get top right box corners
+    ! - glamc(i,j), gphic(i,j) are top right coordinates of box containing 
+    ! - glam(i,j),gphi(i,j)
+    write(6,*) 'averaging'
+    write(6,*) size(gphic),size(gphi)
+    gphic(1:nx,1:ny-1) = 0.5*(gphi(:,1:ny-1)+gphi(:,2:ny))
+    write(6,*) size(glamc),size(glam)
+    glamc(1:nx-1,1:ny) = 0.5*(glam(1:nx-1,:)+glam(2:nx,:))
+  
+    ! - left and right column of longitudes 
+    write(6,*) 'columns'
+    glamc(nx,1:ny) = 1.5*glam(nx,:)-0.5*glam(nx-1,:)
+    glamc( 0,1:ny) = 1.5*glam(1,:)-0.5*glam(2,:)
+    glamc(nx, 0) = glamc(nx,1)
+    glamc( 0, 0) = glamc( 0,1)
+
+    ! - top and bottom row of latitudes by extrapolation
+    write(6,*) 'rows'
+    gphic(1:nx,ny) = 1.5*gphi(:,ny)-0.5*gphi(:,ny-1)
+    gphic(1:nx, 0) = 1.5*gphi(:,1)-0.5*gphi(:,2)
+    gphic( 0,ny) = gphic(1,ny)
+    gphic( 0, 0) = gphic(1, 0)
+
+    !-----------------------------------------------------------------------
+  
+    write(6,*) 'allocating'
+    ALLOCATE( grid_imask(grid_size) )
+    grid_imask(:) = 1
+    write(6,*) name_mask
+    if (trim(name_mask) /= "none") then
+      write(6,*) 'masking'
+      ncstat = nf90_inq_varid( ncid_in, name_mask, varid_mask )
+      call netcdf_error_handler(ncstat)
+      ALLOCATE( mask(nx,ny) )
+      write(6,*) 'reading mask'
+      ncstat = nf90_get_var( ncid_in, varid_mask, mask )
+      call netcdf_error_handler(ncstat)
+      write(6,*) 'setting mask'
+      WHERE ( RESHAPE(mask(:,:),(/ grid_size /)) < value_mask)
+        grid_imask = 0
+      END WHERE
+      write(6,*) 'masked'
+    END IF
+  
+    !-----------------------------------------------------------------------
+    ! corners are arranged as follows:    4 3
+    !                                     1 2
+  
+    ALLOCATE ( corner_lon(4,nx,ny), corner_lat(4,nx,ny) )
+  
+    ! - bottom-left corner
+    corner_lon(1,:,:) = glamc(0:nx-1, 0:ny-1 )
+    corner_lat(1,:,:) = gphic(0:nx-1, 0:ny-1 )
+  
+    ! - bottom-right corner 
+    corner_lon(2,:,:) = glamc(1:nx, 0:ny-1 )
+    corner_lat(2,:,:) = gphic(1:nx, 0:ny-1 )
+  
+    ! - top-right corner
+    corner_lon(3,:,:) = glamc(1:nx,1:ny)
+    corner_lat(3,:,:) = gphic(1:nx,1:ny)
+    write(6,*) corner_lat(3,nx-2:nx,ny)
+  
+    ! - top-left corner
+    corner_lon(4,:,:) = glamc(0:nx-1, 1:ny )
+    corner_lat(4,:,:) = gphic(0:nx-1, 1:ny )
+  
+  ! For [N, E, W]-ward extrapolation near the poles, should we use stereographic (or
+  ! similar) projection?  This issue will come for V,F interpolation, and for all
+  ! grids with non-cyclic grids.
+  
+    ! -----------------------------------------------------------------------------
+    !     correct for 0,2pi longitude crossings
+    !      (In practice this means putting all corners into 0,2pi range
+    !       and ensuring that no box corners are miles from each other.
+    !       3pi/2 is used as threshold - I think this is quite arbitrary.)
+  
+  ! corner_lon(:,:,:) = MODULO( corner_lon(:,:,:), circle )
+  ! DO n = 2, grid_corners
+  !    WHERE    ( corner_lon(n,:,:) - corner_lon(n-1,:,:) < -three*circle*0.25 )
+  !       corner_lon(n,:,:) = corner_lon(n,:,:) + circle
+  !    ELSEWHERE( corner_lon(n,:,:) - corner_lon(n-1,:,:) >  three*circle*0.25 )
+  !       corner_lon(n,:,:) = corner_lon(n,:,:) - circle
+  !    END WHERE
+  ! END DO
+  
+    ! -----------------------------------------------------------------------------
+    ! - reshape for SCRIP input format
+  
+    ALLOCATE( grid_center_lon(grid_size), grid_center_lat(grid_size) )
+    
+    grid_center_lon(:) = RESHAPE( glam(:,:), (/ grid_size /) )
+    grid_center_lat(:) = RESHAPE( gphi(:,:), (/ grid_size /) )
+  
+    DEALLOCATE( glam, gphi, glamc, gphic )
+  
+    ALLOCATE( grid_corner_lon(4, grid_size), grid_corner_lat(4, grid_size) )
+  
+    grid_corner_lon(:,:) = RESHAPE( corner_lon(:,:,:), (/ 4, grid_size /) )
+    grid_corner_lat(:,:) = RESHAPE( corner_lat(:,:,:), (/ 4, grid_size /) )
+  
+    DEALLOCATE( corner_lon, corner_lat )
+  
+    CALL createSCRIPgrid(grid_file_out, grid_name)
+  
+  END SUBROUTINE convertFLUX
+  
+  ! ==============================================================================
+  
+  SUBROUTINE mouldlon(lon_grid, nx, ny)
+
+    ! -----------------------------------------------------------------------------
+    ! - input variables
+
+    INTEGER, INTENT(in) :: nx, ny
+    REAL (kind=dbl_kind), INTENT(inout), DIMENSION(nx,ny) ::  &
+      lon_grid
+  
+    ! -----------------------------------------------------------------------------
+    ! - local variables
+
+    INTEGER :: ix, iy
+    REAL (kind=dbl_kind), DIMENSION(:,:), ALLOCATABLE ::  &
+      dlon
+    REAL :: step
+
+    ! -----------------------------------------------------------------------------
+    ! - try to eliminate any 360 degree steps in a grid of longitudes
+
+    ALLOCATE(dlon(nx,ny))
+
+    step = 0.75*circle
+    dlon(:,:) = 0
+    dlon(2:,:) = lon_grid(2:,:) - lon_grid(:nx-1,:)
+    WHERE (dlon > -step .AND. dlon < step)
+      dlon = 0.0
+    ELSEWHERE
+      dlon = -SIGN(circle,dlon)
+    END WHERE
+
+    ! - close your eyes this is nasty
+    DO ix = 2,nx
+      dlon(ix,:) = dlon(ix,:) + dlon(ix-1,:)
+    END DO
+    lon_grid = lon_grid + dlon
+
+  END SUBROUTINE mouldlon
+  
+  ! ==============================================================================
+  
+  SUBROUTINE createSCRIPgrid(grid_file_out, grid_name)
+  
+    ! -----------------------------------------------------------------------------
+    ! - input variables
+  
+    CHARACTER(char_len), INTENT(in) ::  &
+         grid_name, grid_file_out
+  
+    ! -----------------------------------------------------------------------------
+    ! - local variables that describe the netcdf file
+  
+    INTEGER (kind=int_kind) :: &
+         nc_grid_id,       &   ! netCDF grid dataset id
+         nc_gridsize_id,   &   ! netCDF grid size dim id
+         nc_gridcorn_id,   &   ! netCDF grid corner dim id
+         nc_gridrank_id,   &   ! netCDF grid rank dim id
+         nc_griddims_id,   &   ! netCDF grid dimensions id
+         nc_grdcntrlat_id, &   ! netCDF grid center lat id
+         nc_grdcntrlon_id, &   ! netCDF grid center lon id
+         nc_grdimask_id,   &   ! netCDF grid mask id
+         nc_gridarea_id,   &   ! netCDF grid area id
+         nc_grdcrnrlat_id, &   ! netCDF grid corner lat id
+         nc_grdcrnrlon_id      ! netCDF grid corner lon id
+  
+    ! -----------------------------------------------------------------------------
+    ! - create netCDF dataset for this grid
+    ! - rewrite in nf90 
+    ! - (bring out functional blocks into ncclear for readability)
+  
+    ncstat = nf90_create (grid_file_out, NF90_CLOBBER, nc_grid_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att (nc_grid_id, NF90_GLOBAL, 'title', grid_name)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid size dimension
+  
+    ncstat = nf90_def_dim (nc_grid_id, 'grid_size', grid_size, nc_gridsize_id)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid rank dimension
+  
+    ncstat = nf90_def_dim (nc_grid_id, 'grid_rank', grid_rank, nc_gridrank_id)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid corner dimension
+  
+    ncstat = nf90_def_dim (nc_grid_id, 'grid_corners', grid_corners, nc_gridcorn_id)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid dim size array
+  
+    ncstat = nf90_def_var(nc_grid_id, 'grid_dims', NF90_INT, nc_gridrank_id, nc_griddims_id)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid mask
+  
+    ncstat = nf90_def_var(nc_grid_id, 'grid_imask', NF90_INT, &
+                          nc_gridsize_id, nc_grdimask_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att(nc_grid_id, nc_grdimask_id, 'units', 'unitless')
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid center latitude array
+  
+    ncstat = nf90_def_var(nc_grid_id, 'grid_center_lat', NF90_DOUBLE, &
+                          nc_gridsize_id, nc_grdcntrlat_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att(nc_grid_id, nc_grdcntrlat_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid center longitude array
+  
+    ncstat = nf90_def_var(nc_grid_id, 'grid_center_lon', NF90_DOUBLE, &
+                          nc_gridsize_id, nc_grdcntrlon_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att(nc_grid_id, nc_grdcntrlon_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid corner latitude array
+  
+    grid_dim_ids = (/ nc_gridcorn_id, nc_gridsize_id /)
+    ncstat = nf90_def_var(nc_grid_id, 'grid_corner_lat', NF90_DOUBLE, &
+                          grid_dim_ids, nc_grdcrnrlat_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att(nc_grid_id, nc_grdcrnrlat_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid corner longitude array
+  
+    ncstat = nf90_def_var(nc_grid_id, 'grid_corner_lon', NF90_DOUBLE, &
+                          grid_dim_ids, nc_grdcrnrlon_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att(nc_grid_id, nc_grdcrnrlon_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! end definition stage
+  
+    ncstat = nf90_enddef(nc_grid_id)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! write grid data
+  
+    ncstat = nf90_put_var(nc_grid_id, nc_griddims_id, grid_dims)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_var(nc_grid_id, nc_grdimask_id, grid_imask)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_var(nc_grid_id, nc_grdcntrlat_id, grid_center_lat)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_var(nc_grid_id, nc_grdcntrlon_id, grid_center_lon)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_var(nc_grid_id, nc_grdcrnrlat_id, grid_corner_lat)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_var(nc_grid_id, nc_grdcrnrlon_id, grid_corner_lon)
+    call netcdf_error_handler(ncstat)
+  
+    ncstat = nf90_close(nc_grid_id)
+    call netcdf_error_handler(ncstat)
+  
+    DEALLOCATE( grid_imask, grid_center_lon, grid_center_lat, &
+                grid_corner_lon, grid_corner_lat )
+  
+  
+  END SUBROUTINE createSCRIPgrid
+  
+END MODULE scripgrid_mod
+
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/scripinterp.F90
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/scripinterp.F90	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/scripinterp.F90	(revision 2352)
@@ -0,0 +1,23 @@
+! ==========================================================================
+
+program scripinterp
+
+  use scripinterp_mod
+
+  character (char_len) ::  nm_in
+#if defined ARGC
+  integer :: iargc
+  external iargc
+
+  if (iargc() == 1) then
+    call getarg(1, nm_in)
+    call process_grid(nm_in)
+  else
+    write(6,*) 'need the name of an input namelist'
+  endif
+#else
+  write(6,*) 'enter the name of an input namelist'
+  read(5,*) nm_in
+#endif
+
+end program scripinterp
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/scripinterp_mod.F90
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/scripinterp_mod.F90	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/scripinterp_mod.F90	(revision 2352)
@@ -0,0 +1,1031 @@
+! **************************************************************************
+
+  module scripinterp_mod
+
+! ==========================================================================
+
+  use kinds_mod    ! defines common data types
+  use constants    ! defines common constants
+  use iounits      ! I/O unit manager
+  use netcdf
+  use netcdf_mod   ! netcdf I/O stuff
+  use grids        ! module containing grid info
+  use remap_vars   ! module containing remapping info
+  use remap_mod    ! module containing remapping routines
+  use remap_read   ! routines for reading remap files
+
+  implicit none
+
+  real(kind=dbl_kind), dimension(:), allocatable ::   &
+    grid_out
+
+  integer(kind=int_kind) ::                           &  ! netCDF ids for files and arrays
+          ncstat, nc_outfile_id, nc_infile_id
+  integer (kind=int_kind), dimension(4) ::    &
+      input_dims, input_dimids, input_count
+  real (kind=dbl_kind), dimension(:), allocatable ::   &
+      scale
+  integer (kind=int_kind), dimension(:), allocatable ::        &
+      nc_xysize_id, nc_gridsize_id, nc_gridsize,           &
+      nc_variable_id
+  integer :: nc_lon_id, nc_lat_id, nc_array_id
+
+  character (char_len) ::  &
+          map_name      ! name for mapping from grid1 to grid2
+  character (1), parameter ::  &
+          separator = '|'
+  
+  ! - input namelist variables
+  
+  character (char_len) ::  &
+    input_file,            &  ! filename containing input fields
+    interp_file,           &  ! filename containing remap data (map1)
+    input_name                ! name of variable to grid
+  integer (kind=int_kind), dimension(4) :: &
+    input_stride,  &          ! how much of input array to process
+    input_start,   &          ! where to start
+    input_stop                ! and where to stop
+  character (char_len), dimension(4) ::  &
+    input_vars                ! input variables to be copied
+  
+  ! - output namelist variables
+  
+  character (char_len) ::  &
+    output_file,           &  ! filename for test results
+    output_mode,           &  ! 'create' or 'append'
+    output_name,           &  ! name of new grid variable
+    output_lat,            &  ! as it says
+    output_lon,            &  ! as it says
+    output_ydir               ! choose to invert output arrays in y direction
+  character (char_len), dimension(4) ::  &
+    output_dims,           &    ! name of new grid variable
+    output_vars                 ! variables to copy
+  character (char_len), dimension(10) ::  &
+    output_attributes,     &  ! attributes of stuff in output file
+    output_scaling             ! scaling factor to apply to input data to get
+                               ! correct units in output file
+contains
+
+! ==========================================================================
+
+  subroutine process_grid(nm_in)
+  
+    !-----------------------------------------------------------------------
+    ! - dummy variables
+
+    character (char_len) ::  &
+      nm_in                    ! name of input namelist file
+  
+    !-----------------------------------------------------------------------
+    ! - local variables
+
+    integer (kind=int_kind), dimension(4) ::    &
+        astart, acount, plus_one
+    integer (kind=int_kind), dimension(3) ::    &
+        write_dims
+    integer (kind=int_kind) ::                  &
+      i1, i2, jdim, n, nx, ny, nloop,           &
+      nc_input_id, nc_input_rank,               &
+      vstart, vstride, numv
+
+    real (kind=dbl_kind), dimension(:), allocatable  ::    &
+      grid1_array
+    real (kind=dbl_kind), dimension(:,:), allocatable  ::    &
+      var_out
+
+    plus_one(:) = 1
+
+    !-----------------------------------------------------------------------
+
+    call read_mappings(nm_in)
+
+    !-----------------------------------------------------------------------
+    ! - read input grid
+    ! - WARNING - lots of assumptions here at the moment
+  
+    ncstat = nf90_open( input_file, NF90_NOWRITE, nc_infile_id )
+    call netcdf_error_handler(ncstat,"open")
+  
+    ncstat = nf90_inq_varid( nc_infile_id, input_name, nc_input_id )
+    call netcdf_error_handler(ncstat,"inq_varid")
+  
+    input_dims(:) = 0
+    ncstat = nf90_inquire_variable( nc_infile_id, nc_input_id,   &
+                  ndims=nc_input_rank, dimids=input_dimids(:) )
+    call netcdf_error_handler(ncstat,"inquire_variable")
+
+    do jdim = 1,nc_input_rank
+      ncstat = nf90_inquire_dimension(nc_infile_id,              &
+                    input_dimids(jdim), len=input_dims(jdim) )
+      call netcdf_error_handler(ncstat,"inquire_dimension")
+    enddo
+  
+    ! - dimids seem to be returned in storage order so the outer dimension of 
+    ! - the array as described by the netcdf file becomes the first dimension
+    ! - as far as f90 is concerned (confused? you will be!)
+
+    do jdim = 1,nc_input_rank
+      if (input_stop(jdim) == 0) then
+        input_stop(jdim) = input_dims(jdim)
+      endif
+      input_count(jdim) = input_stop(jdim) - input_start(jdim) + 1
+    enddo
+
+    ! - rashly we assume x followed by y
+    nx = input_dims(1)
+    ny = input_dims(2)
+    write(*,fmt='("Input grid dimensions are:",2i6)') nx, ny
+    if (nx*ny /= grid1_size) then
+      write(6,*) "mismatch between input grid and remap data"
+      stop
+    endif
+
+    ! - calculate number of horizontal slices to process
+    ! - at the moment this is not very general and will only work with 3 dimensions
+
+    acount(1:nc_input_rank) = &
+             (input_stop(1:nc_input_rank)-input_start(1:nc_input_rank)+1) / &
+             input_stride(1:nc_input_rank)
+    nloop = 1
+    do jdim = 1,nc_input_rank
+      nloop = nloop*acount(jdim)
+    enddo
+    nloop = nloop/grid1_size
+    write(6,*) "total slices requested: ",nloop
+
+    vstart = input_start(nc_input_rank)            ! ie extra var has outer dimension
+    vstride = input_stride(nc_input_rank)
+
+    ! - in general we cant read in the whole array so do it slice by slice
+    ! - slow but sure
+
+    write(6,*) "allocating input and output grids"
+    allocate( grid1_array(grid1_size))
+    allocate( grid_out(grid2_size) )
+
+    numv = 0
+    do n = 1,4
+      if (trim(input_vars(n)) /= '-' .and. &
+          trim(output_vars(n)) /= '-') numv = numv + 1
+    enddo
+
+    write_dims(1) = grid2_dims(1)
+    write_dims(2) = grid2_dims(2)
+    write_dims(3) = nloop
+    call define_grid(write_dims(1:3) , 2+numv)
+
+    astart(:) = input_start(:)
+    astart(3) = astart(3) - input_stride(3)
+    acount(:) = 1
+    acount(1) = nx
+    acount(2) = ny
+
+    do n = 1,nloop
+
+      write(6,*) "processing slice: ",n
+      astart(3) = astart(3) + input_stride(3)
+      ncstat = nf90_get_var(nc_infile_id, nc_input_id, grid1_array,  &
+                            start=astart(1:nc_input_rank),              &
+                            count=acount(1:nc_input_rank))
+      call netcdf_error_handler(ncstat,"get_var")
+
+      call calculate_grid(grid1_array, grid_out)
+
+      call write_grid(grid_out, n, write_dims(1:2) , 2)
+
+    enddo
+
+    ! ---------------------------------------------------------------------
+    ! - now for any extra variables to copy
+
+    if (numv > 0) then
+
+      write(6,*) "reading ",numv," extra variables"
+      allocate( var_out(nloop,numv) )
+  
+      do n = 1,numv
+        write(6,*) "looking for variable: ",trim(input_vars(n))
+        ncstat = nf90_inq_varid( nc_infile_id, trim(input_vars(n)), nc_input_id )
+        call netcdf_error_handler(ncstat,"inq_varid")
+      
+        input_dims(:) = 0
+        ncstat = nf90_inquire_variable( nc_infile_id, nc_input_id,   &
+                      ndims=nc_input_rank, dimids=input_dimids(:) )
+        call netcdf_error_handler(ncstat,"inquire_variable")
+  
+        if (nc_input_rank /= 1) then
+          write(6,*) 'sorry, only rank 1 variables can be copied'
+          cycle
+        endif
+        ncstat = nf90_inquire_dimension(nc_infile_id,              &
+                      input_dimids(1), len=input_dims(1) )
+        call netcdf_error_handler(ncstat,"inquire_dimension")
+  
+        ncstat = nf90_get_var(nc_infile_id, nc_input_id, var_out(1:nloop,n),  &
+                              start=(/ vstart /), stride=(/ vstride /))
+        call netcdf_error_handler(ncstat,"get_var")
+      enddo
+  
+      call write_extra(var_out, numv+2)
+      deallocate(var_out)
+
+    endif
+
+    ncstat = nf90_close(nc_outfile_id)
+    call netcdf_error_handler(ncstat,"out close")
+    ncstat = nf90_close(nc_infile_id)
+    call netcdf_error_handler(ncstat,"in close")
+
+    ! ---------------------------------------------------------------------
+
+    deallocate( grid1_array, grid_out)
+
+    ! ---------------------------------------------------------------------
+
+  end subroutine process_grid
+
+  ! ==========================================================================
+
+  subroutine define_grid(thedims, therank)
+
+    !-----------------------------------------------------------------------
+    ! - dummy variables
+    
+    integer (kind=int_kind) :: &
+      therank
+    integer (kind=int_kind), dimension(therank) :: &
+      thedims
+
+    !-----------------------------------------------------------------------
+    ! - local variables
+
+    integer ::               &
+      k, n, ilon, ilat, icolon, i1, i2, natt, nvar, id, jd, kd, nd
+    character (char_len) ::  &
+      aname, vname, att
+    real (kind=dbl_kind) ::   s
+
+    ! - netcdf variables
+
+    integer :: xtype
+
+    !-----------------------------------------------------------------------
+    ! -  define grid size dimensions
+  
+    allocate(nc_xysize_id(grid2_rank))
+    allocate(nc_gridsize_id(therank))
+    allocate(nc_gridsize(therank))
+    allocate(nc_variable_id(therank-2))
+    
+    !-----------------------------------------------------------------------
+    ! - setup a NetCDF file for output
+  
+    xtype = NF90_FLOAT
+
+    write(6,*) 'creating output file'
+    ncstat = nf90_create (output_file, NF90_CLOBBER, nc_outfile_id)
+    call netcdf_error_handler(ncstat,"create")
+  
+    write(6,*) 'setting global attributes'
+    ncstat = nf90_put_att(nc_outfile_id, NF90_GLOBAL, 'title', map_name)
+    call netcdf_error_handler(ncstat,"put_att")
+  
+    write(6,*) 'setting dimensions'
+    do n=1,therank
+      if (n .eq. therank .and. therank .gt. 2) then
+        write(6,*) '    unlimited dim ',trim(output_dims(n)),' size: ',thedims(n)
+        ncstat = nf90_def_dim (nc_outfile_id, output_dims(n), NF90_UNLIMITED, &
+                               nc_gridsize_id(n))
+      else
+        write(6,*) '    dim ',trim(output_dims(n)),' size: ',thedims(n)
+        ncstat = nf90_def_dim (nc_outfile_id, output_dims(n), thedims(n), &
+                               nc_gridsize_id(n))
+      endif
+      call netcdf_error_handler(ncstat,"def_dim")
+    end do
+    nc_gridsize(:) = thedims(1:therank)
+
+    ! - at the moment there is an assumption here that the ordering is (lon,lat)
+
+    ilon = 1
+    ilat = 2
+    nc_xysize_id(1) = nc_gridsize_id(ilon)
+    nc_xysize_id(2) = nc_gridsize_id(ilat)
+
+    ! ----------------------------------------------------------------
+    ! -  define grid center longitude array
+  
+    write(6,*) 'defining longitude variable'
+    ncstat = nf90_def_var (nc_outfile_id, output_lon,   &
+                         xtype, nc_xysize_id,   &
+                         nc_lon_id)
+    call netcdf_error_handler(ncstat,"def_var")
+  
+    ncstat = nf90_put_att (nc_outfile_id, nc_lon_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat,"put_att")
+  
+    ! ----------------------------------------------------------------
+    ! -  define grid center latitude array
+  
+    write(6,*) 'defining latitude variable'
+    ncstat = nf90_def_var (nc_outfile_id, output_lat,     &
+                         xtype, nc_xysize_id,   &
+                         nc_lat_id)
+    call netcdf_error_handler(ncstat,"def_var")
+  
+    ncstat = nf90_put_att (nc_outfile_id, nc_lat_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat,"put_att")
+  
+    ! ----------------------------------------------------------------
+    ! -  define copy variables array
+  
+    write(6,*) 'defining copy variables'
+    do n = 3,therank
+      ncstat = nf90_def_var (nc_outfile_id, output_vars(n-2),   &
+                           xtype, nc_gridsize_id(n),    &
+                           nc_variable_id(n-2))
+      call netcdf_error_handler(ncstat,"def_var")
+    enddo
+  
+    ! ----------------------------------------------------------------
+    ! -  define output array
+  
+    write(6,*) 'defining grid variable'
+    ncstat = nf90_def_var (nc_outfile_id, output_name,               &
+                         xtype, nc_gridsize_id,    &
+                         nc_array_id)
+    call netcdf_error_handler(ncstat,"def_var")
+  
+    ! ----------------------------------------------------------------
+    ! - output attributes has to come after all other definitions
+    ! - this code currently a bit murky, needs a rewrite
+  
+    ncstat = nf90_inquire (nc_outfile_id, nVariables=nvar)
+    call netcdf_error_handler(ncstat,"inquire")
+    do n = 1,10
+      att = trim(output_attributes(n))
+      natt = len(att)
+      if (att /= '-') then
+        i1 = index(att,separator)
+        aname = att(1:i1-1)
+        do k = 1,nvar
+          ncstat = nf90_inquire_variable(nc_outfile_id, k, vname)
+          call netcdf_error_handler(ncstat,"inquire_variable")
+          if (vname == aname) then
+            i2 = index(att,separator,.true.)
+            ncstat = nf90_put_att (nc_outfile_id, k, &
+                                   att(i1+1:i2-1), att(i2+1:natt))
+            call netcdf_error_handler(ncstat,"put_att")
+            exit      ! from innermost do
+          endif
+        enddo
+      endif
+    enddo
+  
+    ! output scaling
+
+    allocate (scale(nvar))
+    scale(:) = 1.0
+
+    do n = 1,10
+      att = trim(output_scaling(n))
+      natt = len(att)
+      if (att /= '-') then
+        i1 = index(att,separator)
+        aname = att(1:i1-1)
+        do k = 1,nvar
+          ncstat = nf90_inquire_variable(nc_outfile_id, k, vname)
+          call netcdf_error_handler(ncstat,"inquire_variable")
+          if (vname == aname) then
+            i2 = index(att,separator,.true.)
+            read(att(i2+1:natt),*) scale(k)
+            call netcdf_error_handler(ncstat,"put_att")
+            exit      ! from innermost do
+          endif
+        enddo
+      endif
+    enddo
+  
+    ! ----------------------------------------------------------------
+    ! -  end definition stage
+  
+    ncstat = nf90_enddef(nc_outfile_id)
+    call netcdf_error_handler(ncstat,"enddef")
+ 
+  end subroutine define_grid
+
+  ! ==========================================================================
+
+  subroutine write_grid(thegrid, thelevel, thedims, therank)
+
+    !-----------------------------------------------------------------------
+    ! - dummy variables
+    
+    integer (kind=int_kind), intent(in) :: &
+      therank, thelevel
+    real (kind=dbl_kind), dimension(:), intent(in) ::   &
+      thegrid
+    integer (kind=int_kind), dimension(therank) :: &
+      thedims
+
+    !-----------------------------------------------------------------------
+    ! - local variables
+
+    integer ::               &
+      k, n, ilon, ilat, icolon, j1, j2, dj, natt, nvar, id, jd, kd, nd
+    character (char_len) ::  &
+      aname, vname, att
+    real (kind=dbl_kind), dimension(:,:,:), allocatable ::   &
+      data
+    real (kind=dbl_kind) ::   s
+    real (kind=dbl_kind), parameter :: todeg = 57.295779513082323
+    integer (kind=int_kind), dimension(3) ::   &
+      start
+
+    ! - netcdf variables
+
+    integer :: xtype
+
+    !-----------------------------------------------------------------------
+    ! - write results to NetCDF file
+  
+    allocate (data(thedims(1),thedims(2),1))
+    if (output_ydir .eq. 'invert') then
+      j1 = thedims(2)
+      j2 = 1
+      dj = -1
+    else
+      j1 = 1
+      j2 = thedims(2)
+      dj = 1
+    endif
+
+    if (thelevel .eq. 1) then
+
+      ! -  grid center latitude array
+  
+      write(6,*) 'writing latitude variable'
+      s = scale(nc_lat_id)
+      nd = 0
+      do jd = j1,j2,dj
+        do id =1,thedims(1)
+          nd = nd + 1
+          data(id,jd,1) = s*todeg*grid2_center_lat(nd)
+        enddo
+      enddo
+      ncstat = nf90_put_var(nc_outfile_id, nc_lat_id, data(:,:,1))
+      call netcdf_error_handler(ncstat,"put_var")
+  
+      ! -  grid center longitude array
+  
+      write(6,*) 'writing longitude variable'
+      s = scale(nc_lon_id)
+      nd = 0
+      do jd = j1,j2,dj
+        do id =1,thedims(1)
+          nd = nd + 1
+          data(id,jd,1) = s*todeg*grid2_center_lon(nd)
+        enddo
+      enddo
+      ncstat = nf90_put_var(nc_outfile_id, nc_lon_id, data(:,:,1))
+      call netcdf_error_handler(ncstat,"put_var")
+
+    endif
+
+    !-----------------------------------------------------------------------
+    ! -  new grid
+
+    write(6,*) 'writing grid variable'
+    n = therank
+    s = scale(nc_array_id)
+    nd = 0
+    do jd = j1,j2,dj
+      do id =1,thedims(1)
+        nd = nd + 1
+        data(id,jd,1) = thegrid(nd)
+      enddo
+    enddo
+    write(6,*) 'scaling data '
+    data(:,:,1) = s*data(:,:,1)
+    start(:) = (/ 1, 1, thelevel /)
+    ncstat = nf90_put_var(nc_outfile_id, nc_array_id, data, start)
+    call netcdf_error_handler(ncstat,"put_var")
+    deallocate(data)
+
+  end subroutine write_grid
+
+  ! ==========================================================================
+
+  subroutine write_extra(thevars, therank)
+
+    real (kind=dbl_kind), dimension(:,:), intent(in) ::   &
+      thevars
+    real (kind=dbl_kind), dimension(:), allocatable ::   &
+      thedata
+    integer (kind=int_kind), intent(in) :: &
+      therank
+    real (kind=dbl_kind) ::   s
+    integer :: n
+
+    allocate( thedata(size(thevars,1)) )
+
+    ! -  copy variable arrays
+
+    write(6,*) 'writing copy variables'
+    do n = 3,therank
+      s = scale(nc_variable_id(n-2))
+      thedata(:) = s*thevars(:,n-2)
+      ncstat = nf90_put_var(nc_outfile_id, nc_variable_id(n-2), thedata)
+      call netcdf_error_handler(ncstat,"put_var")
+    enddo
+
+    deallocate( thedata )
+
+  end subroutine write_extra
+
+  ! ==========================================================================
+
+  subroutine close_grid()
+
+  !     close netCDF file
+  
+    write(6,*) 'closing file'
+    ncstat = nf90_close(nc_outfile_id)
+    call netcdf_error_handler(ncstat,"close")
+  
+  end subroutine close_grid
+
+  ! ==========================================================================
+
+  subroutine read_mappings(nm_in)
+
+    !-----------------------------------------------------------------------
+    ! - dummy variables
+
+    character (char_len) ::  &
+      nm_in                    ! name of input namelist file
+  
+    !-----------------------------------------------------------------------
+    ! - local variables
+  
+    character (char_len) ::   &
+              dim_name    ! netCDF dimension name
+  
+    integer (kind=int_kind) ::     &
+        iunit                                                ! unit number for namelist file
+  
+    !-----------------------------------------------------------------------
+    ! - namelist block
+
+    namelist /interp_inputs/ input_file, interp_file, input_name, &
+                             input_stride, input_start, input_stop, &
+                             input_vars
+    namelist /interp_outputs/ output_dims, output_file, output_mode, output_name, &
+                              output_lat, output_lon, output_ydir,  &
+                              output_scaling, output_vars, output_attributes
+  
+    !-----------------------------------------------------------------------
+    ! - read namelist for file and mapping info
+  
+    input_stride(:) = 1
+    input_start(:) = 1
+    input_stop(:) = 0
+    output_scaling(:) = '-'
+    input_vars(:) = '-'
+    output_lon = '-'
+    output_lat = '-'
+    output_vars(:) = '-'
+    output_ydir = 'none'
+    output_attributes(:) = '-'
+
+    call get_unit(iunit)
+    open(iunit, file=nm_in, status='old', form='formatted')
+    read(iunit, nml=interp_inputs)
+    read(iunit, nml=interp_outputs)
+    call release_unit(iunit)
+    write(*,nml=interp_inputs)
+    write(*,nml=interp_outputs)
+    if (trim(output_mode) == "create") then
+      if (trim(output_lon) == '-' .or. trim(output_lat) == '-') then
+        write(6,*) 'if creating, need to supply lon and lat names'
+        stop
+      endif
+    endif
+
+    !-----------------------------------------------------------------------
+    ! - read remapping data
+    ! - via the scrip package this sets variables:
+    !    grid1_size, grid2_size:     sizes of input and output grids
+    !    grid1_mask, grid2_mask:     masks
+    !    grid1_rank, grid2_rank:     ranks
+  
+    call read_remap(map_name, interp_file)
+  
+  end subroutine read_mappings
+
+  ! ==========================================================================
+
+  subroutine calculate_grid(grid1_array, grid2_array)
+
+    !-----------------------------------------------------------------------
+    ! - dummy variables
+
+    real (kind=dbl_kind), intent(in), dimension(:) ::    &
+      grid1_array
+    real (kind=dbl_kind), intent(out), dimension(:) ::    &
+      grid2_array
+
+    !-----------------------------------------------------------------------
+    ! - local variables
+
+    integer (kind=int_kind), dimension(:), allocatable :: &
+        grid1_imask, grid2_imask, grid2_count
+
+    real (kind=dbl_kind), dimension(:), allocatable :: &
+        grid1_tmp,           &
+        grad1_lat,           &
+        grad1_lon,           &
+        grad1_latlon,        &
+        grad1_lat_zero,      &
+        grad1_lon_zero,      &
+        grid2_tmp1,           &
+        grid2_tmp2
+
+    real (kind=dbl_kind) ::  &
+        delew, delns            ! variables for computing bicub gradients
+
+    integer (kind=int_kind) ::                          &
+        i,j,n,imin,imax,idiff,                          &
+        ip1,im1,jp1,jm1,nx,ny,                          &  ! for computing bicub gradients
+        in,is,ie,iw,ine,inw,ise,isw
+
+    logical, parameter :: lat_gradient = .false.
+  
+    write(6,*) 'starting'
+
+    !-----------------------------------------------------------------------
+    ! - allocate arrays
+  
+    allocate (grid1_tmp      (grid1_size),   &
+              grad1_lat      (grid1_size),    &
+              grad1_lon      (grid1_size),    &
+              grad1_lat_zero (grid1_size),    &
+              grad1_lon_zero (grid1_size),    &
+              grid1_imask    (grid1_size),   &
+              grid2_tmp1     (grid2_size),   &
+              grid2_tmp2     (grid2_size),   &
+              grid2_imask    (grid2_size),   &
+              grid2_count    (grid2_size))
+  
+    write(6,*) 'allocated'
+    write(6,*) grid1_size,grid2_size
+
+    grid1_imask(:) = 1
+    grid2_imask(:) = 1
+    where (grid1_mask)
+      grid1_imask = 1
+    elsewhere
+      grid1_imask = 0
+    endwhere
+    where (grid2_mask)
+      grid2_imask = 1
+    elsewhere
+      grid2_imask = 0
+    endwhere
+
+    write(6,*) 'masked'
+
+    grad1_lat_zero = zero
+    grad1_lon_zero = zero
+    nx = input_dims(1)
+    ny = input_dims(2)
+    write(6,*) nx,ny
+  
+    !-----------------------------------------------------------------------
+    ! - if bicubic, we need 3 gradients in logical space
+  
+    if (map_type == map_type_bicubic) then
+  
+      write(6,*) 'bicubic'
+      write(6,*) grid1_size
+
+      allocate (grad1_latlon (grid1_size)) 
+  
+      do n=1,grid1_size
+  
+        grad1_lat(n) = zero
+        grad1_lon(n) = zero
+        grad1_latlon(n) = zero
+  
+!       if (n.ge.8000) write(6,*) 0,grid1_mask(n),nx
+        if (grid1_mask(n)) then
+  
+          delew = half
+          delns = half
+  
+          j = (n-1)/nx + 1
+          i = n - (j-1)*nx
+  
+          ip1 = i+1
+          im1 = i-1
+          jp1 = j+1
+          jm1 = j-1
+  
+          if (ip1 > nx) ip1 = ip1 - nx
+          if (im1 < 1 ) im1 = nx
+          if (jp1 > ny) then
+            jp1 = j
+            delns = one
+          endif
+          if (jm1 < 1 ) then
+            jm1 = j
+            delns = one
+          endif
+  
+          in  = (jp1-1)*nx + i
+          is  = (jm1-1)*nx + i
+          ie  = (j  -1)*nx + ip1
+          iw  = (j  -1)*nx + im1
+  
+          ine = (jp1-1)*nx + ip1
+          inw = (jp1-1)*nx + im1
+          ise = (jm1-1)*nx + ip1
+          isw = (jm1-1)*nx + im1
+  
+          ! -  compute i-gradient
+  
+          if (.not. grid1_mask(ie)) then
+            ie = n
+            delew = one
+          endif
+          if (.not. grid1_mask(iw)) then
+            iw = n
+            delew = one
+          endif
+   
+          grad1_lat(n) = delew*(grid1_array(ie) - grid1_array(iw))
+!         if (n.ge.8000) write(6,*) 1,grad1_lat(n)
+  
+          ! -  compute j-gradient
+  
+          if (.not. grid1_mask(in)) then
+            in = n
+            delns = one
+          endif
+          if (.not. grid1_mask(is)) then
+            is = n
+            delns = one
+          endif
+   
+          grad1_lon(n) = delns*(grid1_array(in) - grid1_array(is))
+!         if (n.ge.8000) write(6,*) 2,grad1_lon(n)
+  
+          ! -  compute ij-gradient
+  
+          delew = half
+          if (jp1 == j .or. jm1 == j) then
+            delns = one
+          else 
+            delns = half
+          endif
+  
+          if (.not. grid1_mask(ine)) then
+            if (in /= n) then
+              ine = in
+              delew = one
+            else if (ie /= n) then
+              ine = ie
+              inw = iw
+              if (inw == n) delew = one
+              delns = one
+            else
+              ine = n
+              inw = iw
+              delew = one
+              delns = one
+            endif
+          endif
+  
+          if (.not. grid1_mask(inw)) then
+            if (in /= n) then
+              inw = in
+              delew = one
+            else if (iw /= n) then
+              inw = iw
+              ine = ie
+              if (ie == n) delew = one
+              delns = one
+            else
+              inw = n
+              ine = ie
+              delew = one
+              delns = one
+            endif
+          endif
+  
+          grad1_lat_zero(n) = delew*(grid1_array(ine) - grid1_array(inw))
+!         if (n.ge.8000) write(6,*) 3,grad1_lat_zero(n)
+  
+          if (.not. grid1_mask(ise)) then
+            if (is /= n) then
+              ise = is
+              delew = one
+            else if (ie /= n) then
+              ise = ie
+              isw = iw
+              if (isw == n) delew = one
+              delns = one
+            else
+              ise = n
+              isw = iw
+              delew = one
+              delns = one
+            endif
+          endif
+  
+          if (.not. grid1_mask(isw)) then
+            if (is /= n) then
+              isw = is
+              delew = one
+            else if (iw /= n) then
+              isw = iw
+              ise = ie
+              if (ie == n) delew = one
+              delns = one
+            else
+              isw = n
+              ise = ie
+              delew = one
+              delns = one
+            endif
+          endif
+  
+          grad1_lon_zero(n) = delew*(grid1_array(ise) - grid1_array(isw))
+          grad1_latlon(n) = delns*(grad1_lat_zero(n) - grad1_lon_zero(n))
+!         if (n.ge.8000) write(6,*) 4,grad1_lon_zero(n),grad1_latlon(n)
+  
+        endif
+      enddo
+  
+      write(6,*) 'remapping'
+      call remap(grid2_array, wts_map1, grid2_add_map1, grid1_add_map1, &
+                 grid1_array, src_grad1=grad1_lat,                    &
+                 src_grad2=grad1_lon, src_grad3=grad1_latlon)
+  
+      print *,'Third order mapping from grid1 to grid2:'
+      print *,'----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_array  ),maxval(grid2_array  )
+    
+      ! -  Conservation Test
+    
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_array  *grid2_area*grid2_frac)
+    
+    !-----------------------------------------------------------------------
+    ! - a first-order map from grid1 to grid2
+  
+    else if (map_type /= map_type_conserv .AND.map_type /= map_type_bicubic) then
+
+      write(6,*) 'bilinear or conservative'
+  
+      call remap(grid2_array, wts_map1, grid2_add_map1, grid1_add_map1,grid1_array)
+  
+      print *,'First order mapping from grid1 to grid2:'
+      print *,'----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_array  ),maxval(grid2_array  )
+    
+      ! -  Conservation Test
+    
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_array  *grid2_area*grid2_frac)
+    
+    !-----------------------------------------------------------------------
+    ! - conservative mappings:
+    ! - a second-order map from grid1 to grid2 with only lat grads
+  
+    else if (map_type == map_type_conserv .AND. lat_gradient) then
+  
+      call remap(grid2_array, wts_map1, grid2_add_map1, grid1_add_map1,  &
+                 grid1_array, src_grad1=grad1_lat,src_grad2=grad1_lon_zero) 
+  
+      select case (norm_opt)
+      case (norm_opt_none)
+        grid2_tmp2 = grid2_frac*grid2_area
+        where (grid2_tmp2 /= zero)
+          grid2_array = grid2_array/grid2_tmp2
+        elsewhere
+          grid2_array = zero
+        end where
+      case (norm_opt_frcarea)
+      case (norm_opt_dstarea)
+        where (grid2_frac /= zero)
+          grid2_array = grid2_array/grid2_frac
+        elsewhere
+          grid2_array = zero
+        end where
+      end select
+  
+      print *,'Second order mapping from grid1 to grid2 (lat only):'
+      print *,'----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_array  ),maxval(grid2_array  )
+  
+      ! -  Conservation Test
+  
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_array*grid2_area*grid2_frac)
+  
+    !-----------------------------------------------------------------------
+    ! - conservative mappings:
+    ! - a second-order map from grid1 to grid2 both gradients
+  
+    else if (map_type == map_type_conserv .AND..NOT. lat_gradient) then
+  
+      call remap(grid2_array,wts_map1,grid2_add_map1,grid1_add_map1,  &
+                 grid1_array, src_grad1=grad1_lat,src_grad2=grad1_lon) 
+  
+      select case (norm_opt)
+      case (norm_opt_none)
+        grid2_tmp2 = grid2_frac*grid2_area
+        where (grid2_tmp2 /= zero)
+          grid2_array = grid2_array/grid2_tmp2
+        elsewhere
+          grid2_array = zero
+        end where
+      case (norm_opt_frcarea)
+      case (norm_opt_dstarea)
+        where (grid2_frac /= zero)
+          grid2_array = grid2_array/grid2_frac
+        elsewhere
+          grid2_array = zero
+        end where
+      end select
+  
+      print *,'Second order mapping from grid1 to grid2:'
+      print *,'-----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_array  ),maxval(grid2_array  )
+  
+      ! -  Conservation Test
+  
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_array*grid2_area*grid2_frac)
+  
+    endif
+  
+    !-----------------------------------------------------------------------
+    !     calculate some statistics
+  
+    grid2_count = zero
+    grid2_tmp1  = zero
+    grid2_tmp2  = zero
+  
+    print *,'number of sparse matrix entries ',num_links_map1
+    do n=1,num_links_map1
+      grid2_count(grid2_add_map1(n)) = grid2_count(grid2_add_map1(n)) + 1
+      if (wts_map1(1,n) > one .or. wts_map1(1,n) < zero) then
+        grid2_tmp1(grid2_add_map1(n)) = grid2_tmp1(grid2_add_map1(n)) + 1
+        grid2_tmp2(grid2_add_map1(n)) = max(abs(wts_map1(1,n)),grid2_tmp2(grid2_add_map1(n)) )
+      endif
+    end do
+  
+    do n=1,grid2_size
+      if (grid2_tmp1(n) > zero) print *,n,grid2_tmp2(n)
+    end do
+  
+    imin = minval(grid2_count, mask=(grid2_count > 0))
+    imax = maxval(grid2_count)
+    idiff =  (imax - imin)/10 + 1
+    print *,'total number of dest cells ',grid2_size
+    print *,'number of cells participating in remap ',count(grid2_count > zero)
+    print *,'min no of entries/row = ',imin
+    print *,'max no of entries/row = ',imax
+  
+    imax = imin + idiff
+    do n=1,10
+      print *,'num of rows with entries between ',imin,' - ',imax-1,   &
+               count(grid2_count >= imin .and. grid2_count < imax)
+      imin = imin + idiff
+      imax = imax + idiff
+    end do
+  
+    !-----------------------------------------------------------------------
+    ! - deallocate arrays
+  
+    deallocate (grid1_tmp, grad1_lat, grad1_lon,    &
+                grad1_lat_zero, grad1_lon_zero, grid1_imask,     &
+                grid2_tmp1, grid2_tmp2,   &
+                grid2_imask, grid2_count)
+  
+  end subroutine calculate_grid
+
+  ! ==========================================================================
+
+end module scripinterp_mod
+
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/scripshape.F90
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/scripshape.F90	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/scripshape.F90	(revision 2352)
@@ -0,0 +1,419 @@
+      PROGRAM scripshape
+!
+! program to take output from the SCRIP weights generator
+! and rearrange the data into a series of 2D fields suitable
+! for reading with iom_get in NEMO configurations using the
+! interpolation on the fly option
+!
+      USE netcdf
+      IMPLICIT none
+      INTEGER    :: ncId, VarId, status
+      INTEGER    :: start(4), count(4)
+      CHARACTER(LEN=1) :: y
+      INTEGER    :: nd, ns, nl, nw, sx, sy, dx, dy
+      INTEGER    :: i, j, k, m, n, smax
+!
+!  ifort -O2 -o scripshape scripshape.f90 \
+!        -I/nerc/packages/netcdfifort/v3.6.0-pl1/include \
+!        -L/nerc/packages/netcdfifort/v3.6.0-pl1/lib -lnetcdf
+!
+!
+      INTEGER(KIND=4), ALLOCATABLE :: src(:)
+      INTEGER(KIND=4), ALLOCATABLE :: dst(:)
+      REAL(KIND=8), ALLOCATABLE :: wgt(:,:)
+      REAL(KIND=8), ALLOCATABLE :: src1(:,:),dst1(:,:),wgt1(:,:)
+      LOGICAL  :: around, verbose
+#if defined ARGC
+      INTEGER(KIND=4) :: iargc
+      EXTERNAL :: iargc
+#endif
+
+      CHARACTER(LEN=256) :: interp_file, output_file, name_file
+      INTEGER            :: ew_wrap
+      NAMELIST /shape_inputs/ interp_file, output_file, ew_wrap
+
+! scripshape requires 1 arguments; the name of the file containing
+! the input namelist.
+! This namelist contains:
+!     the name of the input file containing the weights ! produced by SCRIP in its format;
+!     the name of the new output file which ! is to contain the reorganized fields ready for input to NEMO.
+!     the east-west wrapping of the input grid (-1, 0, 1 and 2 are accepted values)
+!
+! E.g.
+!     interp_file = 'data_nemo_bilin.nc'
+!     output_file = 'weights_bilin.nc'
+!     ew_wrap     = 2
+!
+#if defined ARGC
+      IF (iargc() == 1) THEN
+        CALL getarg(1, name_file)
+      ELSE
+        WRITE(*,*) 'Usage: scripshape namelist_file'
+        STOP
+      ENDIF
+#else
+      WRITE(6,*) 'enter name of namelist file'
+      READ(5,*) name_file
+#endif
+      interp_file = 'none'
+      output_file = 'none'
+      ew_wrap = 0
+      OPEN(12, FILE=name_file, STATUS='OLD', FORM='FORMATTED')
+      READ(12, NML=shape_inputs)
+      CLOSE(12)
+!
+      INQUIRE(FILE = TRIM(interp_file), EXIST=around)
+      IF (.not.around) THEN
+       WRITE(*,*) 'Input file: '//TRIM(interp_file)//' not found'
+       STOP
+      ENDIF
+! 
+      INQUIRE(FILE = TRIM(output_file), EXIST=around)
+      IF (around) THEN
+       WRITE(*,*) 'Output file: '//TRIM(output_file)//' exists'
+       WRITE(*,*) 'Ok to overwrite (y/n)?'
+       READ(5,'(a)') y
+       IF ( y .ne. 'y' .AND. y .ne. 'Y' ) STOP
+      ENDIF
+!
+      verbose = .true.
+!
+! Obtain grid size information from interp_file
+!
+      CALL ncgetsize
+!
+! Allocate array spaces
+!
+      ALLOCATE(src(nl), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('src')
+      ALLOCATE(dst(nl), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('dst')
+      ALLOCATE(wgt(nw,nl), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('wgt')
+      ALLOCATE(src1(dx,dy), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('src1')
+      ALLOCATE(dst1(dx,dy), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('dst1')
+      ALLOCATE(wgt1(dx,dy), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('wgt1')
+!
+! Read all required data from interp_file
+!
+      CALL ncgetfields
+!
+! Check that dst is monotonically increasing
+!
+      DO k = 1,nl-1
+       IF(dst(k+1).lt.dst(k)) THEN
+        WRITE(*,*) 'non-monotonic at ',k
+        WRITE(*,*) dst(k-4:k+16)
+        STOP
+       ENDIF
+      END DO
+!
+! Remove references to the top row of src
+!
+      IF(verbose) WRITE(*,*) &
+        'Removing references to the top row of the source grid'
+      smax = (sy-1)*sx
+      n = 0
+      DO k = 1,nl
+       IF(src(k).gt.smax-1) THEN
+        src(k) = src(k)-sx
+        n = n + 1
+       ENDIF
+      END DO
+      IF(verbose) WRITE(*,*) n,' values changed (',100.*n/nl,'%)'
+!
+! Loop through weights for each corner in turn and
+! rearrange weight fields into separate 2D fields for
+! reading with iom_get in NEMO
+!
+      DO k = 1,nw
+       DO n = 1,4
+
+        i = 0
+        j = 1
+        DO m = n,nl,4
+         i = i+1
+         IF(i.gt.dx) THEN
+          i = 1
+          j = j + 1
+         ENDIF
+         src1(i,j) = src(m)
+         dst1(i,j) = dst(m)
+         wgt1(i,j) = wgt(k,m)
+        END DO
+!
+! Write out this set which will be labelled with
+! a 2 digit number equal to n+4*(k-1)
+!
+        CALL wrwgts
+!   
+       END DO
+      END DO
+      STOP
+      CONTAINS
+!
+!----------------------------------------------------------------------*
+      SUBROUTINE ncgetsize
+!
+! Access grid size information in interp_file and set the
+! following integers:
+!
+!    nd = dst_grid_size
+!    ns = src_grid_size
+!    nl = num_links    
+!    nw = num_wgts     
+! sx,sy = src_grid_dims     
+! dx,dy = dst_grid_dims     
+!
+      INTEGER idims(2)
+!
+       status = nf90_open(interp_file, nf90_NoWrite, ncid)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_dimid(ncid, 'dst_grid_size', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_inquire_dimension(ncid, VarId, LEN = nd)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_dimid(ncid, 'src_grid_size', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_inquire_dimension(ncid, VarId, LEN = ns)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_dimid(ncid, 'num_links', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_inquire_dimension(ncid, VarId, LEN = nl)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_dimid(ncid, 'num_wgts', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_inquire_dimension(ncid, VarId, LEN = nw)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       start = 1
+       count = 2
+       status = nf90_inq_varid(ncid, 'src_grid_dims', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_get_var(ncid, VarId, idims, start, count)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       sx = idims(1) ; sy = idims(2)
+!
+       status = nf90_inq_varid(ncid, 'dst_grid_dims', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_get_var(ncid, VarId, idims, start, count)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       dx = idims(1) ; dy = idims(2)
+!
+       status = nf90_close(ncid)
+       IF (status /= nf90_noerr) CALL handle_err(status)
+!
+       IF(verbose) THEN
+         WRITE(*,*) 'Detected sizes: '
+         WRITE(*,*) 'dst_grid_size: ', nd
+         WRITE(*,*) 'src_grid_size: ', ns
+         WRITE(*,*) 'num_links    : ', nl
+         WRITE(*,*) 'num_wgts     : ', nw
+         WRITE(*,*) 'src_grid_dims: ', sx, ' x ', sy
+         WRITE(*,*) 'dst_grid_dims: ', dx, ' x ', dy
+       ENDIF
+!
+      END SUBROUTINE ncgetsize
+
+!----------------------------------------------------------------------*
+      SUBROUTINE ncgetfields
+!
+! Read all required data from interp_file. The data read are:
+!
+! netcdf variable    size   internal array
+!-----------------+-------+--------------
+! src_address        nl     src
+! dst_address        nl     dst
+! remap_matrix     (nw,nl)  wgt
+!
+       status = nf90_open(interp_file, nf90_NoWrite, ncid)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_varid(ncid, 'src_address', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! Read the values for src
+       status = nf90_get_var(ncid, VarId, src, &
+                         start = (/ 1 /),      &
+                         count = (/ nl /))
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_varid(ncid, 'dst_address', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! Read the values for dst
+       status = nf90_get_var(ncid, VarId, dst, &
+                         start = (/ 1 /),      &
+                         count = (/ nl /))
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_varid(ncid, 'remap_matrix', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! Read the values for wgt
+       status = nf90_get_var(ncid, VarId, wgt, &
+                         start = (/ 1, 1 /),   &
+                         count = (/ nw, nl /))
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_close(ncid)
+       IF (status /= nf90_noerr) CALL handle_err(status)
+!
+      END SUBROUTINE ncgetfields
+
+!----------------------------------------------------------------------*
+      SUBROUTINE handle_err(status)
+!
+! Simple netcdf error checking routine
+!
+      INTEGER, intent ( in) :: status
+!
+      IF(status /= nf90_noerr) THEN
+       IF(trim(nf90_strerror(status)) .eq. 'Attribute not found') THEN
+! ignore
+       ELSE
+        WRITE(*,*) trim(nf90_strerror(status))
+        STOP "Stopped"
+       END IF
+      END IF
+      END SUBROUTINE handle_err
+
+!----------------------------------------------------------------------*
+      SUBROUTINE alloc_err(arname)
+!
+! Simple allocation error checking routine
+!
+      CHARACTER(LEN=*) :: arname
+!
+      WRITE(*,*) 'Allocation error attempting to ALLOCATE '//arname
+      STOP "Stopped"
+      END SUBROUTINE alloc_err
+
+!                                                                       
+!----------------------------------------------------------------------*
+      SUBROUTINE wrwgts
+!
+! Write out each set of 2D fields to output_file.
+! Each call will write out a set of srcXX, dstXX and wgtXX fields
+! where XX is a two digit number equal to n + 4*(k-1). The first
+! and last calls to this routine initialise and close the output
+! file respectively. The first call is detected when k*n=1 and the
+! last call is detected when k*n=4*nw. The outfile file remains
+! open between the first and last calls. 
+!
+      INTEGER :: status, ncid, ncin
+      INTEGER :: Lontdid, Lattdid
+      INTEGER :: tvid, tvid2, tvid3
+      INTEGER :: ioldfill
+      CHARACTER(LEN=2) :: cs
+      SAVE ncid
+!
+      IF(k*n.eq.1) THEN
+!
+! Create output_file and set the dimensions
+!
+         status = nf90_create(output_file, nf90_Clobber, ncid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+         status = nf90_set_fill(ncid, nf90_NoFill, ioldfill)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_def_dim(ncid, "lon", dx, Lontdid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+         status = nf90_def_dim(ncid, "lat", dy, Lattdid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_put_att(ncid, nf90_global, 'ew_wrap', ew_wrap)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+      ELSE
+!
+! Reenter define mode
+!
+         status = nf90_redef(ncid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+      ENDIF
+!
+      WRITE(cs,'(i2.2)') n + 4*(k-1)
+!
+! Define new variables
+!
+      status = nf90_def_var(ncid, "src"//cs, nf90_double, &
+                         (/ Lontdid, Lattdid /), tvid)
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+      status = nf90_def_var(ncid, "dst"//cs, nf90_double, &
+                         (/ Lontdid, Lattdid /), tvid2)
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+      status = nf90_def_var(ncid, "wgt"//cs, nf90_double, &
+                         (/ Lontdid, Lattdid /), tvid3)
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! Leave define mode
+!
+      status = nf90_enddef(ncid)
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! Write the data
+!
+      status = nf90_put_var(ncid, tvid, src1,    &
+                            start = (/ 1, 1 /),  &
+                            count = (/ dx, dy /) )
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+      status = nf90_put_var(ncid, tvid2, dst1,   &
+                            start = (/ 1, 1 /),  &
+                            count = (/ dx, dy /) )
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+      status = nf90_put_var(ncid, tvid3, wgt1,   &
+                            start = (/ 1, 1  /), &
+                            count = (/ dx, dy /) )
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+      IF(k*n.eq.4*nw) THEN
+!
+! --     Reenter define mode
+!
+         status = nf90_redef(ncid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! --     Reopen interp_file and transfer some global attributes
+!
+         status = nf90_open(interp_file, nf90_NoWrite, ncin)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_copy_att(ncin,NF90_GLOBAL,'title',        ncid,NF90_GLOBAL)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_copy_att(ncin,NF90_GLOBAL,'normalization',ncid,NF90_GLOBAL)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_copy_att(ncin,NF90_GLOBAL,'map_method',   ncid,NF90_GLOBAL)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_copy_att(ncin,NF90_GLOBAL,'conventions',  ncid,NF90_GLOBAL)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_copy_att(ncin,NF90_GLOBAL,'history',      ncid,NF90_GLOBAL)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! --     Close interp_file
+!
+         status = nf90_close(ncin)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! --     Close output_file
+!
+         status = nf90_close(ncid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+      ENDIF
+
+      END SUBROUTINE wrwgts
+      END PROGRAM scripshape
Index: branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/timers.f90
===================================================================
--- branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/timers.f90	(revision 2352)
+++ branches/nemo_v3_3_beta/NEMOGCM/TOOLS/WEIGHTS/src/timers.f90	(revision 2352)
@@ -0,0 +1,343 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module uses F90 cpu time routines to allowing setting of
+!     multiple CPU timers.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: timers.f,v 1.2 2000/04/19 21:56:26 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module timers
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod
+
+      implicit none
+
+      integer (kind=int_kind), parameter ::   &
+           max_timers = 99  ! max number of timers allowed
+
+      integer (kind=int_kind), save ::  &
+           cycles_max       ! max value of clock allowed by system
+
+      integer (kind=int_kind), dimension(max_timers), save ::  &
+           cycles1,          & ! cycle number at start for each timer
+           cycles2          ! cycle number at stop  for each timer
+
+      real (kind=real_kind), save ::   &
+           clock_rate       ! clock_rate in seconds for each cycle
+
+      real (kind=real_kind), dimension(max_timers), save ::   &
+           cputime          ! accumulated cpu time in each timer
+
+      character (len=8), dimension(max_timers), save ::   &
+           status           ! timer status string
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine timer_check(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine checks a given timer.  This is primarily used to
+!     periodically accumulate time in the timer to prevent timer cycles
+!     from wrapping around max_cycles.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::   &
+          timer            ! timer number
+
+!-----------------------------------------------------------------------
+
+      if (status(timer) .eq. 'running') then
+        call timer_stop (timer)
+        call timer_start(timer)
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timer_check
+
+!***********************************************************************
+
+      subroutine timer_clear(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine resets a given timer.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::   &
+          timer            ! timer number
+
+!-----------------------------------------------------------------------
+
+      cputime(timer) = 0.0_real_kind  ! clear the timer
+
+!-----------------------------------------------------------------------
+
+      end subroutine timer_clear
+
+!***********************************************************************
+
+      function timer_get(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine returns the result of a given timer.  This can be
+!     called instead of timer_print so that the calling routine can 
+!     print it in desired format.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::   &
+          timer            ! timer number
+
+!-----------------------------------------------------------------------
+!
+!     Output Variables:
+!
+!-----------------------------------------------------------------------
+
+      real (kind=real_kind) ::   &
+           timer_get   ! accumulated cputime in given timer
+
+!-----------------------------------------------------------------------
+
+      if (status(timer) .eq. 'stopped') then
+        timer_get = cputime(timer)
+      else
+        call timer_stop(timer)
+        timer_get = cputime(timer)
+        call timer_start(timer)
+      endif
+
+!-----------------------------------------------------------------------
+
+      end function timer_get
+
+!***********************************************************************
+
+      subroutine timer_print(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine prints the accumulated cpu time in given timer.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::   &
+          timer            ! timer number
+
+!-----------------------------------------------------------------------
+
+      !--- 
+      !--- print the cputime accumulated for timer 
+      !--- make sure timer is stopped
+      !---
+
+      if (status(timer) .eq. 'stopped') then
+        write(*,"(' CPU time for timer',i3,':',1p,e16.8)")   &
+             timer,cputime(timer)
+      else
+        call timer_stop(timer)
+        write(*,"(' CPU time for timer',i3,':',1p,e16.8)")   &
+             timer,cputime(timer)
+        call timer_start(timer)
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timer_print
+
+!***********************************************************************
+
+      subroutine timer_start(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine starts a given timer.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::   &
+          timer            ! timer number
+
+!-----------------------------------------------------------------------
+
+      !---
+      !--- Start the timer and change timer status.
+      !---
+
+      if (status(timer) .eq. 'stopped') then
+        call system_clock(count=cycles1(timer))
+        status(timer) = 'running'
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timer_start
+
+!***********************************************************************
+
+      subroutine timer_stop(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine stops a given timer.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::   &
+          timer            ! timer number
+
+!-----------------------------------------------------------------------
+
+      if (status(timer) .eq. 'running') then
+
+        !---
+        !--- Stop the desired timer.
+        !---
+
+        call system_clock(count=cycles2(timer))
+
+        !---
+        !--- check and correct for cycle wrapping
+        !---
+
+        if (cycles2(timer) .ge. cycles1(timer)) then
+          cputime(timer) = cputime(timer) + clock_rate*   &
+                           (cycles2(timer) - cycles1(timer))
+        else
+          cputime(timer) = cputime(timer) + clock_rate*   &
+                      (cycles2(timer) - cycles1(timer) + cycles_max)
+        endif
+
+        !---
+        !--- Change timer status.
+        !---
+
+        status(timer)='stopped'
+
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timer_stop
+
+!***********************************************************************
+
+      subroutine timers_init
+
+!-----------------------------------------------------------------------
+!
+!     This routine initializes some machine parameters necessary for
+!     computing cpu time from F90 intrinsics.
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: cycles ! count rate return by sys_clock
+
+!-----------------------------------------------------------------------
+
+      !---
+      !--- Initialize timer arrays and clock_rate.
+      !---
+
+      clock_rate = 0.0_real_kind
+      cycles1    = 0
+      cycles2    = 0
+      cputime    = 0.0_real_kind
+      status     = 'stopped'
+
+      !---
+      !--- Call F90 intrinsic system_clock to determine clock rate
+      !--- and maximum cycles.  If no clock available, print message.
+      !---
+
+      call system_clock(count_rate=cycles, count_max=cycles_max)
+
+      if (cycles /= 0) then
+        clock_rate = 1.0_real_kind/real(cycles)
+      else
+        clock_rate = 0.0_real_kind
+        print *, '--- No system clock available ---'
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timers_init
+
+!***********************************************************************
+
+      end module timers
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
